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1.  INTRODUCTION 

Previous  studies  of  fast  metal  combustion  such  as  exploding  wire  or  under  water 
shaped  charge  have  demonstrated  that  a  theoretical  description  of  the  process  calls  for 
constructing  a  transient  model  rather  than  existing  quasi-steady  models.  In  some  particular 
cases  of  volatile  metal  combustion  of  large  droplets  (larger  than  80  micron  ),  radiation  heat 
exchange  between  the  droplet  surface  and  the  surrounding  oxide  cloud  cannot  be  ignored. 
Special  care  was  taken  in  Ref.  1  to  properly  account  for  the  oxide  cloud  and  the  metal  sur- 
face radiation.  Oxide  cloud  formation,  convection  and  deposition  can  be  described  by  the 
transport  equation  of  the  second  phase.  The  metal  is  treated  as  a  single  phase  whether  it 
is  liquia  or  vapor.  This  is  accomplished  through  a  judiciuos  choice  of  enthalpy  which 
accounts  for  vapor  quality  and  latent  heat  of  vaporization.  Metal-vapor  interface  location  is 
found  indirectly  by  searching  for  a  point  where  the  temperature  is  equal  to  the  saturated 
vapor  temperature  corresponding  to  the  local  metal  partial  pressure,  and  metal  vapor  qual- 
ity is  zero. 

In  Ref.  1,  we  described  the  equations  for  SDherical,  one  dimensional,  transient  com- 
bustion an  including  oxide  as  a  second  pnase.  in  order  to  imbed  these  equations  in  a 
computer  program,  we  will  use  the  general  purpose  code  PHOENICS  ,  Ref.  2.  Since  this 
code  is  not  restricted  to  one  spatial  dimension,  once  the  feasibility  of  the  1-D  model  in  this 
phase  of  the  work  has  been  demonstrated,  it  may  be  extended  to  2-D  (axisymmetric  using  r 
and  8  as  spatial  variables)  in  a  straightforward  manner. 

2.  THE  GENERAL  TRANSPORT  EQUATION  IN  PHOENICS 

The  underlying  idea  of  PHOENICS  difference  scheme  is  that  all  transport  equations  are 
re-cast  in  a  uniform  format-  the  "general  transport  equation".  The  formating  includes  the 
energy  conservation  equation.  The  governing  equations  for  our  model  are  conventionally 
written  as  written  as  follows: 


Energy  equation  phase  1: 

p,Dh,/Dt  =  V(K.VTi)  +  Q",  (1) 

Energy  equation  phase  2: 

p2Dh2/Dt  =  V(K&T2)  +  Q"2  (2) 


Species  mass  fraction: 

p.Dc./Dt  =V(piDj0Vc.)  +  w".  (3) 


Momentum  phase  1 


Momentum  phase  2 


piDVi/Dt  =V(p.iVv,)  +  M21  (4) 


p2DV2/'Dt  =  t7(p2\7V2)  +  M,2  (5) 


The  continuity  equation  for  each  phase: 

d(pu%i)/dl  +    (piVt^i)  =  m21  (6) 

d(pz&2)/ct  +    (p2V2^2)  =  -m21  (7) 


As  shown  by  Spalding  (Ref.  2),  these  equations  can  be  presented  in  th  following  gen- 

ft 

eralized  form,  utilizing  in  addition  to  the  property  O,  source  terms  S  <*,  and  exchange  coef- 
ficients r^ 


p.DO./Dt  =V(r0VO.)  +S0i  (8) 

Where: 
The  variable  <D.  =  hi,h2,c.,Vi,V2  (8a) 


tr  ft 


The  source  S    =  Q  i,Q  2,w  .,Mi2,iM2i  (8b) 

The  exchange  coefficient: 

rO  =  K/cptpiDj0,m,n2  (8c) 


This  generalization  enables  the  use  of  a  single  numerical  scheme  for  all  transport 
equations.    PHOENICS  is  built  in  three  main  parts  described  in  Fig.  1. 


Fig.  1  The  various  subprograms  in  PHOENICS. 


EARTH  Include  the  numeric  finite  differences  scheme  and  written  as 

binary  code. 
SATLIT  The  management  program,  where  the  problem  is  declared: 

steady/unsteady,  parabolic  or  eliptic  ,  boundary  conditions, 

relaxation  factors  etc. 
FLDDAT  Initial  values  definition  for  each  variable  O^being  used. 

GROUND  For  variables  updating  and  sources  definition. 


3.  CORRECTION  CONDUCTION  TERM  IN  ENERGY  EQUATION 

Special  care  should  be  excercised  in  recasting  the  energy  equation  into  the  general 
format.  The  problem  arises  from  the  heat  conduction  term  which  should  be  a  divergence  of 
K  T.  Since  the  generalizated  energy  variable  is  enthalpy  rather  than  temperature,  the  heat 
flux  is  related  indirectly  to  the  enthalpy.  In  PHOENICS  this  difficulty  is  resolved  by  assum- 
ing a  constant  (  temperature  and  composition  independent)  value  of  c  . 

This  approximation  is  inacceptable  for  our  model.  In  the  sequel,  we  dwell  on  the  rea- 
sons for  that  and  on  the  proposed  remedy. 

There  are  three  major  factors  that  prohibit  the  assumption  of  constant  c  .  These  are: 

(a)  Large  temperature  gradients. 

(b)  Large  composition  gradients  (especially  in  the  combustion 
region  and  around  the  liquid  metal/vapor  interface). 

(c)  The  conductive  heat  flux  constitutes  a  non-negligible  fraction 
of  the  total  heat  flux  (conduction  +  convection  +  radiation). 

The  remedy  for  this  problem  is  to  introduce  a  suitable  source  term  into  the  PHOENICS- 
generalized  energy  equation.  This  source  term  is  just  the  difference  between  the  correction 
heat  flux  divergence  and  the  enthalpy  flux  divergence.  For  our  model,  the  appropriate 
energy  source  correction  term  is: 


S  corr  -  5[(K/c  )[c    (dcjdy)  +  c    (dcjdy)  +  cp    frJM)  (T-298)]/fly 

o        M  H  wv 

-  <3[(K/cp)h  J&cJMVdi 

-  d[(K/cp)[(1-x)hMfg(dc„/ay)  -  hMfgcM(<?x/<?y)]]/<?y  (9) 


Note  that  last  term  in  Eq.  9  vanishes  except  in  the  transition  region  between  metal  liquid 
and  vapor,  where  x  is  a  fraction  number. 

In  the  case  of  a  1-D  configuration,  finite-  difference  gradient  approximation  is  available 
in  PHOENICS  and  described  in  Ref.  3. 


c[(T)dh/dy]  =  (hE-hp)  /  [  5ye./rp  +  tyJTJ 

-  (hp-hw)  /  [  5yw./rp  +  Aywt/rH] 


(10) 


Where    p  is  the  center  node  and  E  and  W  are  its  sides  neighbors,  as  described  below: 


1  w* 


0 


*y„ 


oy 


0 

p 


-  ef 


E 


»  e 

We  used  this  difference  scheme  in  computing  the  corrective  energy  terms. 


4.  VARIABLE  NAMES  AND  FLOWCHART 

In  this  chapter  we  wil  present  the  metal  combustion  variables  used  in  PHOENICS  and 
the  implementation  of  the  model  equations  as  they  appear  in  chapter  6  of  Ref.  1..  The  defi- 
nition of  the  problem  and  its  boundary  condition  was  declared  in  SATLIT.  The  initial  condi- 
tions were  set  in  FLDDAT.  The  various  sources,  the  iterations  procedures  of  surface  and 
oxide  cloud  location  together  with  the  other  combustion  model  were  inserted  in  GROUND. 
The  reader  can  follow  the  flow  chart  together  with  using  the  FORTRAN  list  in  the  appendix. 


NAME  IN 

THE  PROGRAM 


NAME  OF  VARIABLE 


IN  EQUATION 


APPEAR  IN 


EQUATION  NO. 


GAI 

GAO 

GAP 

GAQ 

GCDT 

GCP 

GCPI 

GCPOX 

GCPO 

GCP1 

GCP2 

GCP3 

GCP4 

GC1 

GC2 

GC3 


s. 

i 


a 

p 

E/R 

rr 

w 


c  0 
p 


c  1 
p 


c  2 

p 


c  3 
p 


c  4 

p 


6-27 

C 

6-28 

C 

6-26,30 

6-34 

6-34 

C 

6-51  c 

C 

6-26C 

6-51  c 

6-51  c 

6-5 1c 

6-51  c 

6-5 1c 

6-39 

C 

6-39 

C 

6-39 

C 

GC1MIN  N  .  parameter  for 


nun 


radiation  beginning 


GD  D.o  6-49 


GDD  D  6-48 

pmjk 

GD1  pi  6-55 


GD2  p: 

GEG  e  6-26,30 

9 

GEP  e  6-25 

p 

GEW  £w  6-26,30 

GF  cjc  6-35a,b 

n     wv 

GFCW  F  6-29 

c-w 

GFG  iH  6-37a 

GFOX  i  6-37b 

ox 

GGAMH1  k/c 

pg 

GHFGM  hMfg 

GHFOX  hoyfg 

GHFU  Hfu 

GHOXS  Q"12 

GHOXV  Q"i3 

GHOX0  hox° 

GH1M  hMl 

GH3M  hM3 

GK  k. 

GKA  B 

GKMF  KMf 


6-4 

6-32 

6-5 

6-6a 

C 

6-6b 

C 

6-33a 

6-9 

C 

6-10 

C 

6-5 1a 

C 

6-34 

GKO  kj0  6-5 1a 

GK1  k„  6-51  a 

GK2  k.2  6-5 1a 

GK3  kj3  6-51  a 

GK4  kj4  6-5 1a 

GL  I  6-25 

GLSOX  hoxsf  6-6b 

GM  Jlj  6-5 1a 

GMDT  wox"  6-37a,b 

GMM  M./Mk  6-52 

GMO  )ij0  6-51, b 


GM1 
GM2 
GM3 
GM4 
GN  N.  6-23 


GRFC 
GROF 


*ti 


»3Z 


*» 


»3« 


i 


min 


GNMI  N 

i 

GNN  N  6-24 

GPAL  pM  6-18 

P 


rc  6-29 


GPT 
GRC 

GRCI  rc.  6-27,28 

GRCo  r 


CO 


%»     .  6-26 

net 


'Mf 


6-21 


GROG 

GROO 

GROU 

GROUCM 

GROUOX 

GRW 

GR2 

GSIG 

GSUMD 

GSUMF 

GSUMK 

GSUMN 

GSUMU 

GSUMV 

GSXM2 

GSXM1 

GTEMP 

GTEMPO 

GTG 

GTOX 

GTW 

GVISC 

GXMET 

GXMETA 

*  Calculated  in  that  equation. 
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term  in  Eq.  9 
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Fig.  2  General  flow-chart  of  the  model  in  PHOENICS 
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5.  SUMMARY 

We  presented  a  prescription  for  embedding  the  1-D  droplet  combustion  model  that  had 

been  proposed  in  a  Ref.  1  into  the  PHOENICS  code.  Extensive  programming  modifications 

are  required,  primarily  due  to  the  introduction  of  special  constructed  (finite-  difference) 

source  terms.  These  terms  are  of  two  distinct  types.    The  corrective  type  was  inserted  into 

the  energy  equation  in  order  to  offset  errors  introduced  by  the  general  equation  format  of 

PHOENICS,  which   is   based  on  an  assumption  of  constant  c  ,  that  does  not  hold   in  the 

p 

present  model. 

The  second  type  is  true  mass  and  energy  source  terms.  The  mass  source  is  due  to  the 
progress  of  chemical  reactions.   The  energy  source  is  due  to  radiative  heat  transfer. 

The  debugging  phase  has  just  about  been  completed  at  the  time  this  report  was  writ- 
ten. We  regard  the  1-D  model  as  a  test  case  for  droplet  combustion  in  steam.  Most-  but  not 
all  -  the  physical  factors  are  represented  in  the  model.  Specially,  oxide  deposition  on  a 
moving  droplet  can  be  modeled  in  a  2-D  (axisymmetric)  computation. 

Once  the  1-D  test  computations  prove  statisfactory,  the  road  is  clear  to  proceed  with  the 
2-D  model. 


H 


In  this  appendix  we  will  pesent  the  FORTRAN  listing  of  PHOENICS  which  includes  our 
model  for  metal  combustion  in  steam. 


ICHAP,ISTP,ISWP,IZED,INDVAR) 


C$DIRECTIVE**MAIN 

C    *FILE  NAME:  MODGRD.FTN 

C    ^INCLUDED  SUBROUTINES:  THE  MODELS  OF  MAIN,  GROUND  8  STRIDE 

C    ^DOCUMENTATION:  PHOENICS  INSTRUCTION  MANUAL  (SPRING  1983). 

C    ^SATELLITE  FILE  NAME:  MODSTL.FTN 

C0MM0N/ISHIFT/IIK57),NFMAX 
C  SET  F-ARRAY  DIMENSION  AS  NEEDED,  S  SET  NFMAX  ACCORDINGLY. 
COMMON  FC25000) 
NFMAX=25000 
CALL  MAIN1 
STOP 
END 
C$DIRECTIVEx*GROUND 

SUBROUTINE  GROUNDCIRN 
C$INCLUDE  9,CMNGUSSI . FTN/G 
LOGICAL  L0GIC1, LOGIC 
DIMENSION  LOGIC(IOO) 
COMMON/LDATA/LOGICK309) 
EQUIVALENCE  (  L0GIC(  1 ),  LOGICK  210)  ) 
DIMENSION  INTGR(IOO) 
COMMON/ 1  DATA/ 1 NTGRK 194) 
EQUIVALENCE  ( INTGR( 1 ) , INTGRK 95) ) 
DIMENSION  RE(IOO) 
C0MM0N/RDATA/REK421) 
EQUIVALENCE  ( RE( 1 ) , RE1 ( 322) ) 
COMMON/BOUND/LOCREG(60), 
STR1,CP1RK7),VP1RK7),CP2RK5) 
VP1R2(7) 
VP1R3C7) 
VP1R4(7) 
VP1R5C7) 
VP1R6(7) 
VP1R7C7) 
VP1R8(7) 
VP1R9(7) 


8TR2. 

STR3 

8TR4. 

8TR5, 

&TR6. 


CP1R2C7) 
XP1R3C7) 
CP1R4(7) 
CP1R5C7) 
■CP1R6C7) 
8TR7,CP1R7(7) 
&TR8,CP1R8(7) 
STR9,CP1R9(7) 


CP2R2C5) 
CP2R3(5) 
CP2R4C5) 
CP2R5(5) 
CP2R6(5) 
CP2R7C5) 
CP2R8(5) 
CP2R9C5) 


CPNRK5) 
CPNR2C5) 
CPNR3C5) 
CPNR4(5) 
CPNR5(5) 
CPNR6C5) 
CPNR7(5) 
CPNR8(5) 


VPNRK5) 
VPNR2C5) 
VPNR3(5) 
VPNR4C5) 
VPNR5C5) 
VPNR6(5) 
VPNR7(5) 
VPNR8C5) 


CPNR9(5),VPNR9(5) 


VP2RK5) 
VP2R2(5) 
VP2R3(5) 
VP2R4(5) 
VP2R5(5) 
VP2R6C5) 
VP2R7C5) 
VP2R8(5) 
VP2R9C5) 

8TR10,CP1R10(7),VP1R10(7),CP2R10(5),VP2R10(5),CPNR10(5),VPNR10(5) 
DIMENSION  TCVREGC350) 
EQUIVALENCE  (TCVREGC 1 ) ,TR1 ) 
C$INCLUDE  9,GUSSEQUI.FTN/G 

LOGICAL  CARTES, POLAR, SPDATA, SKEW, TWODYZ, ONEDZ, STOVAR( 25), 
&    S0LVAR(25),PRINT(25),RESID(25),CMPRSS,C0NEMU,LSP1, 

5  CONRHO,EMDOT,ONEPHS,INCORE(10),ISAVED,SAVEI,SAVEM, 

8    RESTRT,XCYCLE,MONITR,REGION( 10), STEADY, WHOLEP, SLABPP, 

6  RAIN, BLOCKZ,PWSTAG,RUN( 30), PLOT, RESMAP, FLAG, BLOCK, 
S   TEST, C0NC1C4), DISTIL 

LOGICAL  SPRESS,PARAB,DONACC, OVERLY, SACC, 
8    GUSSIE, CATHY, CONNIE, CORA, ESTER, FLASH, FLORA, 
8    FOCS,GENMIX, HESTER, PICALO, PLANT, SPLASH, HELGA, 
8    TACT, TIBALT,TOPSI, PAMELA, TABLES, WSTAG, 
8    CONMOD,GROSTA,SUBPST,SUBWGR 

EQUIVALENCE  (CARTES, LOGIC1 ( 1 )), (POLAR, LOGIC1 (2) ) , 
8    (SPDATA,  LOGICK  3)),  (SKEW,  LOGICK  4)),  (TWODYZ,  LOGICK  5)), 
8    ( ONEDZ, L0GIC1(6)),(ST0VAR(1),L0GIC1(7)), 
8    (S0LVAR(1),L0GIC1(32)),(PRINT(1),L0GIC1(57)), 
8    (RESID(1),L0GIC1(82)),(CMPRSS,L0GIC1(107)), 
8    (CONEMU,LOGIC1(108)),(LSP1,LOGIC1(109)), 
8    (CONRHO,LOGIC1(110)),(EMDOT,LOGIC1(111)), 
8    (0NEPHS,L0GIC1(112)),(INC0RE(1),L0GIC1(113)) 

EQUIVALENCEdSAVED,  LOGICK  123 )),(SAVEI,  LOGICK  124)), 
8    (SAVEM,L0GIC1(125)),(RESTRT,L0GIC1(126)), 
8    (XCYCLE,L0GIC1(127)),(M0NITR,L0GIC1(128)), 
8    (REGION(  1 ),  LOGIC1  (  1 29  )),(  STEADY,  LOGICK  139)), 
8    (WHOLEP, LOGICK 140)), (SLABPP, LOGICK 141)), 
8    ( RAI N, LOGICK 142 )),(BLOCKZ, LOGICK 143)), 
8    ( PWSTAG, L OGICK 144 )),(RUN(1), LOGICK 145)), 
8    (PLOT,  LOGICK  175  )),(  RESMAP,  L0GICK176)), 
8    (FLAG,  LOGICK  177)),  (BLOCK,  LOGICK  178)),  (TEST,  LOGICK  179)) 

EQUIVALENCE(CONCKl),  LOGICK  206)) 

EQUIVALENCE  ( SPRESS, LOGIC( 100 ) ) , (PARAB, L0GIC(99 ) ) , 
8    (D0NACC,L0GIC(98)) 

EQUIVALENCE  ( OVERLY, LOGIC(96 )), (SACC, LOGIC( 95) ) , 
8    (WSTAG, L0GIC(94)) 


MEL00010 
MEL00020 
MEL00030 
MEL00040 
MEL00050 
MEL00060 
MEL00070 
MEL00080 
MEL00090 
MEL00100 
MEL00110 
MEL00120 
MEL00130 
MEL00140 
MEL00150 
MEL00160 
MEL00170 
MEL00180 
MEL00190 
MEL00200 
MEL00210 
MEL00220 
MEL00230 
MEL00240 
MEL00250 
MEL00260 
MEL00270 
MEL30230 
MEL00290 
MEL00300 
MEL00310 
MEL00320 
MEL00330 
MEL00340 
MEL00350 
MEL00360 
MEL00370 
MEL00380 
MEL00390 
MEL00400 
MEL00410 
MEL00420 
MEL00430 
MEL00440 
MEL00450 
MEL00460 
MEL00470 
MEL00480 
MEL00490 
MEL00500 
MEL00510 
MEL00520 
MEL00530 
MEL00540 
MEL00550 
MEL00560 
MEL00570 
MEL00580 
MEL00590 
MEL00600 
MEL00610 
MEL00620 
MEL00630 
MEL00640 
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EQUIVALENCE  ( DISTIL , L0GICC90 ) )  MEL00730 

EQUIVALENCE  ( PAMELA, L0GIC(67 )), (TOPSI , L0GICC66 )) ,  MEL00740 

8    (TIBALT,L0GIC(65)),(TACT,L0GIC(64)),(HELGA,L0GIC(63)),  MEL  007 50 

8    (SPLASH, L0GIC(62)), (PLANT, L0GIC(61 ) ) , ( PICALO, LOGIC(60 ) ) ,  MEL  0076  0 

8    (HESTER,L0GIC(59)),(GENMIX,L0GIC(58)),(F0CS,L0GIC(57)),  MEL  0077  0 

8    ( FLORA, LOGIC( 56 )),( FLASH, LOGIC( 55 )),( ESTER, LOGIC( 54)),  MEL  0  078  0 

&    (C0RA,L0GIC(53)),(C0NNIE,L0GIC(52)),(CATHY,L0GIC(5D),  MEL  0  079  0 

8    (GUSSIE,L0GIC(50))  MEL00800 

EQUIVALENCE  (TABLES, LOGIC( 48 )), (CONMOD, L0GIC( 47 )) ,  MEL00810 

8    (GR0STA,L0GIC(46)),(SUBPST,L0GIC(45))  MEL00820 

EQUIVALENCE  ( SUBWGR, LOGIC( 43) )  MEL00830 

INTEGER  FSTEP,FSWEEP,TSTSWP,ITAB(8),MTABVR(8)  MEL00840 

DIMENSION  ISPCS0(25),LITER(25)  MEL00850 

EQUIVALENCE  ( NX, INTGR1 ( 1 ) ) , ( NY, INTGR1 (2) ) ,  MEL00860 

8    (NZ,INTGR1(3)),(ISPCS0(1),INTGR1(4)),  MEL00870 

8    (NREGN,INTGR1(29)),(NPHI,INTGR1(30)),  MEL00880 

8    (LITKE,INTGR1(31)),(LITHYD,INTGR1(32)),  MEL00890 

8    (LITH,INTGR1(33)),(LITCNC,INTGR1(34)),  MEL00900 

8    (LITSLB,INTGR1(35)),(NRUN,INTGR1(36 J),  MEL00910 

8    (LITER(1),INTGR1(37)),(FSTEP,INTGR1(62)),  MEL00920 

8    (FSWEEP,INTGR1(63)), ( LSTEP, INTGR1 (64) )  MEL00930 

EQUIVALENCE  ( LSNEEP, INTGR1 (65) ) , ( NPRINT, INTGR1 (66 ) ) ,  MEL00940 

8    (IERRP,INTGR1(67)),(IMAXP,INTGR1(68)),  MEL00950 

8    (IEMU1,INTGR1(69)),(IXMON,INTGR1(70)),  MEL00960 

8    (IYM0N,INTGR1(71)),(IZM0N,INTGR1(72)),  MEL00970 

8    (KEMU,INTGR1(73)),(KMAIN,INTGR1(74)),  MEL00980 

8    (KINDEX,INTGR1(75)),(KGE0M,INTGR1(76)),  MEL00990 

8    (KINPUT,INTGR1(77)),(KS0DAT,INTGR1(78))  MEL01000 

EQUIVALENCE(KFLAG,INTGR1(79)),(KCOMPF,INTGR1(80)),  MEL  01 010 

8    (KS0RCE,INTGR1(81)),(KLES1D,INTGR1(82)),  MEL01020 

8    (KLES2D,INTGR1(83)),(KLES3D,INTGR1(84)),  MEL01030 

8    (KC0MPP,INTGR1(85)),(KADJST,INTGR1(86)),  MEL01040 

8    (KFLUX,INTGR1(87)), (KSHIFT, INTGR1 (88 ) ) ,  MEL01050 

8    (K0UTPT,INTGR1(89)),(KDIF,INTGR1(90)),  MEL01060 

8    (KC0MPU,INTGR1(91)),(KC0MPV,INTGR1(92)),  MEL01070 

8    (KC0MPW,INTGR1(93)),(KC0MPR,INTGR1(94))  MEL01080 

EQUIVALENCE  ( KELIN, INTGR( 100 ) ) , (MEANDF, INTGR( 99 ) ) ,  MEL01090 

8    (NUMCLS,INTGR(98)),  MEL01100 

8    (IRH01,INTGR(97)),(IRH02,INTGR(96)),  MEL01110 

8    (IZW1,INTGR(95)),(IZW2,INTGR(94)),  MEL01120 

8    (MGRID,INTGR(93)),(KWALL,INTGR(92)),  MEL01130 

8    (IZPR1,INTGR(91)),(IZPR2,INTGR(90)),  MEL01140 

8    (ISTPR1,INTGR(89)),(ISTPR2,INTGR(88)),  MEL01150 

8    (NTPRIN,INTGR(87))  MEL01160 

EQUIVALENCE  ( IMDOT, INTGR(86 ) ) , ( IHSAT, INTGR(85) ) ,  MEL01170 

8    (ICFIP,INTGR(84)),(NTABLE,INTGR(83)),(NTABVR,INTGR(82)),  MEL  01180 

8    (LINTAB,INTGR(81)),(NPRTAB,INTGR(80)),(NMON,INTGR(79)),  MEL  01 190 

8    (ITAB(1),INTGR(71)),(MTABVR(1),INTGR(63)),  MEL01200 

8    (NZPRIN,INTGR(62)),  MEL01210 

8    (NXPRIN,INTGR(61)),(NYPRIN,INTGR(60)),  MEL01220 

8    (LDISTL,INTGR(59)),(TSTSWP,INTGR(58)),  MEL01230 

8    (KDBEXP,INTGR(57)),(KDBRH0,INTGR(56)),  MEL01240 

8    (KDBMDT,INTGR(55))  MEL01250 

EQUIVALENCE  ( ILOOP1 , INTGR(53) ) , ( ILOOPN, INTGR( 52) ) ,  MEL01260 

8    (IPBP,INTGR(51)),(IZPRF,INTGR(50)),  MEL01270 

8    (IZPRL,INTGR(49)),(ISTPRF,INTGR(48)),  MEL01280 

8    (ISTPRL,INTGR(47)),(KDBGEN,INTGR(46)),  MEL01290 

8    (IVELF,INTGR(45)),(IVELL,INTGR(44)),  MEL01300 

8    (IKEF,INTGR(43)),(IKEL,INTGR(42)),  MEL01310 

8    (IENTF,INTGR(41)),(IENTL,INTGR(40)),  MEL01320 

8    (ICNCF,INTGR(39)),(ICNCL,INTGR(38)),  MEL01330 

8    (NVEL,INTGR(37)),(NKE,INTGR(36)),  MEL01340 

8    (NENT,INTGR(35)),(NCNC,INTGR(34)),  MEL01350 

8    (NZSTP,INTGR(33)),(NPRMNT,INTGR(32))  MEL01360 

DIMENSION  SPARE1(20),XUDIST(30),YVDIST(30),ZWDIST(50),  MEL01370 

8    SIGMA(25),CRIT(25),DTFALS(25),RESREF(25),  MEL01380 

8    TITLE(25),FIINIT(25),TFRAC(30)  MEL01390 

EQUIVALENCE  (SPARE1 ( 1 ) , RE1 ( 1 ) ) ,  MEL01400 

8    (TFRAC(1),RE1(21)),(XULAST,RE1(51)),  MEL01410 

8    (YVLAST,RE1(52)),(ZWLAST,RE1(53)),  MEL01420 

8    (XUDIST(1),RE1(54)),(YVDIST(1),RE1(84)),  MEL01430 

8    (ZWDIST(1),RE1(114)),(SIGMA(1),RE1(164)),  MEL01440 
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5  (CRIT(1),RE1(189)),(DTFALS(1),RE1(214)), 
a    (RESREF(1),RE1(239)),(EMU1,RE1(264)), 

6  (RH01,RE1(265)),(RH02,RE1(266)), 
&    (TLAST,RE1(267)),(CFIPS,RE1(268)) 

EQUIVALENCE  ( AMDOT, RE1 ( 26  9 ) ) , ( FIINITC 1 ) , RE1 (270) ) , 

5  (RELAXP,RE1(295)),(TITLE(1),RE1(296)), 

6  (DT,RE1(321)), 

8    (RINNER,ZWDIST(50)),(SNALFA,ZWDIST(49)), 
8    (PBAR,ZWDIST(48)) 
EQUIVALENCE  ( SLOEMU, RE( 1 00) ) , ( SLORHO, RE( 99 ) ) , ( RLXRHO, RE(98 ) ) , 


a 


(RH0MIN,RE(96)) 
(EMUMIN,RE(94)) 
(TKEMIN,RE(92)) 


(RH0MAX,RE(97)) 
(EMUMAX,RE(95)) 
(TKEMAX,RE(93)) 
(RLXPZ,RE(91)), 
(ABUOY,RE(90)), ( HREF, RE(89 ) ) , 
(AGRAVX,R£(88)),(AGRAVY,RE(37)), 
S    (AGRAVZ,RE(36)),(ATIME,RE(85)) 

EQUIVALENCE  ( RLXPXY, RE( 84 ) ) , 
a    (EPSMAX,RE(83)), ( EPSMIN, RE(82) ) , 
a    (ARH01,REC81)), ( BRH01 , RE(3  0 ) ) , (CRH01 , RE(79 ) ) 

EQUIVALENCE  ( AZW2, RE( 73) ) , ( BZW2, RE(74 ) ) , 
8    (PINT,RE(75)),(CZW2,RE(76)), 
a    (DZ,RE(78)),(ZWL,RE(77)),(ZW2M1T,RE(72)), 
8    (VELMIN,RE(70)),(VELMAX,RE(69)), 
8    (FALC0M,RE(68)),(CMD0T,RE(67)), 
a    (RLXMDT,RE(66)),(AMDTMX,RE(65)) 
a    (RADMAX,RE(63)),(RADMIN,RE(62)) 
a    (PRESS, RE(61)),(CP1,RE(60)), 
a    (CP2,RE(59)),(CP3,RE(58)),(FST0IC,RE(57) 
a    (ARRC0N,RE(56)),(PREEXP,RE(55)),(CA1I,RE 
EQUIVALENCE  ( CA2I , RE( 53) ) , (CA13, RE(52) ) , (CA 
a    (H1SAT,RE(50)), ( H2SAT, R£( 49 ) ) , 
a    (EMULAM,RE(48)) 
EQUIVALENCE  (TWPRCN , RE( 42) ) , ( PSATEX, RE( 41 ) ) 
EQUIVALENCE (EL  EXP, RE (39) ) , ( EWALL , RE( 38 ) ) , 
8    (SIGE,RE(37)),(SIGK,RE(36)),(TAUDK,RE(35 
DIMENSION  L0C1(6),L0C2(6),L0C3(6),L0C4(6),L 
8    LOC6(6),LOC7(6),LOC8(6),LOC9(6),LOC10(6) 
EQUI VAL ENCE  ( LOCREG( 1 ) , L OC1 ( 1 ) ) , ( LOCREG( 7 ) , 
(L0CREG(13),L0C3(1)),(L0CREG(19 
(L0CREG(25),L0C5(1)),(L0CREG(31 
(L0CREG(37),L0C7(1)),(L0CREG(43 
(L0CREG(49),L0C9(1)),(L0CREG(55 
XUFRAC(30),YVFRAC(30),ZWFRAC(30), 
XFRAC(30),YFRAC(30),ZFRAC(30) 


EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

EQUIVALENCE 

DIMENSION 

DIMENSION 


(AMDTMN,RE(64)), 


), 

(54)) 

23,RE(51)), 


)) 
0C5(6), 

L0C2(D) 

),L0C4(D) 

),L0C6(D) 

),L0C8(D) 

),L0C10(D) 

ENDIK25) 


(LITCNCLITC), 
) 


EQUIVALENCE(XUDIST(1),XUFRAC(1),XFRAC(D), 
8  (YVDIST(1),YVFRAC(1),YFRAC(D), 

8  (ZWDIST(1),ZWFRAC(1),ZFRAC(D) 

a         (endit(D,crit(D),(rlxp,relaxp: 

EQUIVALENCE  (NPRMON, LITER( 1 ) ) 
CLUDE  9,NMLIST.FTN/G 
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  1  STARTS: 

++MEANING  OF  SUBROUTINE  ARGUMENTS: 

IRN=RUN  NUMBER;  ICHAP=CHAPTER  CALLED;  ISTP=TIME  STEP; 

ISWP=SOLUTION  SWEEP;  IZED=Z-SLAB;  INDVAR:  SEE  CHAPTERS  BELOW. 
++USER-INTRODUCED  VARIABLES  a  ARRAYS: 

TO  AVOID  CONFLICT  WITH  VARIABLE  NAMES  USED  IN  COMMON,  ALL 

VARIABLES  INTRODUCED  BY  THE  USER  SHOULD  HAVE  NAMES  STARTING 

WITH  »G«  IF  REAL,  'J'  IF  INTEGER,  AND  »G'  OR  'J'  IF  LOGICAL. 

THUS  GDZ(IZ)  MIGHT  BE  A  Z-INTERVAL  ARRAY; 

GW1(IY,IX)  A  2-D  ARRAY  FOR  AXIAL  VELOCITY;  ETC. 

USER-GENERATED  SUBROUTINES  SHOULD  BE  NAMED  CORRESPONDINGLY, EG 

SUBROUTINE  GVISC(GTEMP,GCNC, GVSC) ,  FOR  COMPUTING  VISCOSITY 

FROM  CONCENTRATION  8  TEMPERATURE. 
++GROUND-TO-EARTH  CONNECTING  SUBROUTINES: 
XUSE  GET(NAME,GARRAY,NY,NX)  TO  PUT  VALUES  OF  VARIABLE  NAMED 

•NAME'  INTO  ARRAY  'GARRAY'  DIMENSIONED  GARRAY(NY, NX) . 
XUSE  SET(NAME,IXF,IXL,IYF,IYL, GARRAY, NY, NX)  TO  SET  VARIABLE 

'NAME'  TO  GARRAY(IY,IX)  OVER  THE  REGION:  IXF-IXL  8  IYF-IYL . 
XUSE  PRNSLB(NAME)  TO  PRINT  VARIABLE  'NAME'  OVER  X-Y  PLANE. 
XUSE  ADD(NAME,IXF,IXL,IYF,IYL,TYPE,CM,VM,CVAR,VVAR,NY,NX) 


MEL01450 
MEL01460 
MEL01470 
MEL01480 
MEL01490 
MEL01500 
MEL01510 
MEL01520 
MEL01530 
MEL01540 
MEL01550 
MEL01560 
MEL01570 
MEL01580 
MEL01590 
MEL01600 
MEL01610 
MEL01620 
MEL01630 
MEL01640 
MEL01650 
MEL01660 
MEL01670 
MEL01680 
MEL01690 
MEL01700 
MEL01710 
MEL01720 
MEL01730 
MEL01740 
MEL01750 
MEL01760 
MEL01770 
MEL01780 
MEL01790 
MEL01800 
MEL01310 
MEL01820 
MEL01830 
MEL01840 
MEL01850 
MEL01860 
MEL01870 
MEL01880 
MEL01890 
MEL01900 
MEL01910 
MEL01920 
MEL01930 
MEL01940 
MEL01950 
MEL01960 
MEL01970 
MEL01980 
MEL01990 
MEL02000 
MEL02010 
MEL02020 
MEL02030 
MEL02040 
MEL02050 
MEL02060 
MEL02070 
MEL02080 
MEL02090 
MEL02100 
MEL02110 
MEL02120 
MEL02130 
MEL02140 
MEL02150 
MEL02160 
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C 

C 

C 

C 

C 

C 

C 

C 

C+  +++ 

C 

C 

C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

C    1 

c 
c 

C++++ 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


TO  ADD  SOURCE  TO  VARIABLE  NAMED  'NAME'  ( 
XUSE  READIZ(IZED)  IN  CHAPTERS  1,  2,  8,  & 

8  VOL,... AHDZ.  (SEE  FOOTNOTE  TO  LEGALITY 
XUSE  GET1D(NAME, GARRAY, NDIM)  TO  PUT  VARIA 
ONE-D  ARRAY  'GARRAY'  DIMENSIONED  NDIM,  T 
CALL  GET1D(NAME,GNX,NX)  FOR  XC...DXG  8 
CALL  GET1D(NAME,GNY,NY)  FOR  YG,...RV  8  D 
CALL  GET1D(NAME,GNZ,NZ)  FOR  ZG, ...WGRID 
+LEGALITY  TABLE  FOR  USE  OF  EARTH-CONNECTI 
ENTRIES  IN  TABLE  GIVE  CHAPTERS  IN  WHICH 
USED  FOR  VARIABLES  IN  LEFT-HAND  COLUMN. 
STRIDE  IS  REGARDED  AS  BEING  IN  CHAPTER  3 


SEE  CHAPTER  5). 

9  TO  ACCESS  PI, . . .DM 

TABLE) 
BLE  NAMED  'NAME'  IN 
HUS: 

DIMENSION  GNX(NX); 
IMENSION  GNY(NY); 
8  DIMENSION  GNZ(NZ) . 
NG  SUBROUTINES: 
SUBROUTINES  CAN  BE 
(SUBROUTINE 
) 


:  VARIABLE: 

:   GET  8 
:    PRNSLB 

SET 

ADD 

READIZ 

GET1D  : 

:P1  -  RZ    : 

ALL 

6  8  7 

5 

1,2,3,9 

NONE  : 

:P10  "  RZH: 

:3-7,  10-16 

3 

NONE 

NONE 

NONE  : 

:VOL  -AHDZ: 

:     ALL 

3 

NONE 

1,2,8,9 

NONE  : 

:D1DP 

:     NONE 

10 

NONE 

NONE 

NONE  : 

:D2DP        : 

:     NONE 

11 

NONE 

NONE 

NONE  : 

:MU1,MU1H  : 

:  5,13-16 

12 

NONE 

NONE 

NONE  : 

:EXCO(L,H): 

:     NONE 

13 

NONE 

NONE 

NONE  : 

:CFP        : 

5 

14 

NONE 

NONE 

NONE  : 

:MDT         : 

:       5 

15 

NONE 

NONE 

NONE  : 

:HST1,HST2: 

:   5  8  15 

16 

NONE 

NONE 

NONE  : 

:XG  -WGRID: 

:     NONE 

NONE 

NONE 

NONE 

ALL   : 

NOTES  ON  ABOVE  TABLE: 
XIN  CHAPTERS  1,  2,  8,  8  9  VARIABLES  PI... DM  8  GEOMETRY 

VOL... AHDZ  CAN  BE  ACCESSED  BUT  ONLY  IN  CONJUNCTION  WITH 

USE  OF  READIZ,  THUS: 

DO  1  IZED=1,NZ 

CALL  READIZ(IZED) 

CALL  GET( ...  AS  REQUIRED. . ) 
XGEOMETRY  ACCESSED  BY  READIZ  IS  THAT  AT  INITIAL  TIME. 
XD1DP  8  D2DP  ONLY  ACCESSIBLE  IN  UNSTEADY  FLOWS. 
+GROUND  SERVICE  SUBROUTINES: 
XUSE  C0NTUR(NAME,IPLANE,IL0C,NINT,I1,I2,J1,J2,GARRAY,NDIM)  FOR 

LINE-PRINTER  PLOTS  OF  CONTOURS.  'NAME*  =  U1,...C4; 

'IPLANE'=  XPLANE,  YPLANE,  OR  ZPLANE;  ILOC  SETS  IX,  IY,  OR 

IZ  LOCATION  OF  IPLANE;  II,  12,  Jl,  8  J2  SET  FIRST  8  LAST 

CELLS  IN  HORIZ.  8  VERT.  ON  PLOT;  GARRAY  IS  1-D  WORKING  ARRAY 

OF  DIMENSION  NXXNY,  NXXNZ,  OR  NYXNZ  DICTATED  BY  IPLANE;  8 

NDIM  SETS  VALUE  OF  DIMENSION  OF  GARRAY. 
XUSE  FLD2DA(TITLE, GARRAY, NY, NX)  TO  PRINT  ANY  ARRAY  DIMENSIONED 

GARRAY(NY,NX);  SET  'TITLE'  TO  REQUIRED  NAME  (  4  HOLLERITH 

CHARACTERS  ONLY) . 
XUSE  FLD3DA(TITLE, GARRAY, NX, NY, NZ, IPLANE, ILOC)  TO  PRINT  ANY 

ARRAY  DIMENSIONED  GARRAY( NX, NY, NZ)  IN  PLANE  SPECIFIED  BY 

'IPLANE'  8  'ILOC  AS  FOR  CONTUR  ABOVE;  SET  'TITLE'  AS  FOR 

FLD2DA. 

VARIABLE  NAMES  FOR  USE  IN  GROUND: 

COMMON/TYPE/CELL, EAST, WEST, NORTH, SOUTH, HIGH, LOW, VOLUME, WALL 

C0MM0N/VAR/P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS, 
SKE,EP,H1,H2,H3,C1,C2,C3,C4,RX,RY,RZ,S1,S2 

C0MM0N/VAR0LD/P10,PP0,U10,U20,V10,V20,W10,W20,R10,R20,RS0, 
SKE0,EP0,H10,H20,H30,C10,C20,C30,C40,RX0,RY0,RZ0,S10,S20 

C0MM0N/VARL0W/P1L,PPL,U1L,U2L,V1L,V2L,W1L,W2L,R1L,R2L,RSL, 
SKEL,EPL,H1L,H2L,H3L,C1L,C2L,C3L,C4L,RXL,RYL,RZL,S1L,S2L 

C0MM0N/VARHI/P1H,PPH,U1H,U2H,V1H,V2H,W1H,W2H,R1H,R2H,RSH, 
SKEH,EPH,H1H,H2H,H3H,C1H,C2H,C3H,C4H,RXH,RYH,RZH,S1H,S2H 

COMMON/GMTRY/VOL,VOLO,AEAST,ANORTH,AHIGH,AEDX, ANDY, AHDZ 

C0MM0N/PR0P/D1,D2,D1DP,D2DP,MU1,MU1LAM,EXC0,CFP,MDT,HST1,HST2 

C0MM0N/PRP0LD/D10,D20 

C0MM0N/PRPL0W/D1L,D2L,EXC0L 

C0MM0N/PRPHI/D1H,D2H,MU1H,EXC0H 

COMMON/VARNX/XG, XU , DXU , DXG 

COMMON/VARNY/YG,YV,DYV,DYG,R,RV 

COMMON/VARNZ/ZG,ZWl,DZW,DZG, WGRID 

COMMON/GDMSCI/XPLANE, YPLANE, ZPLANE, ITNO 

COMMON/GDMSCL/LSLAB,MSLAB,HSLAB,LAMMU 


MEL02170 
MEL02180 
MEL02190 
MEL02200 
MEL02210 
MEL02220 
MEL02230 
MEL02240 
MEL02250 
MEL02260 
MEL02270 
MEL02280 
MEL02290 
MEL02300 
MEL02310 
MEL02320 
MEL02330 
MEL02340 
MEL02350 
MEL02360 
MEL02370 
MEL02380 
MEL02390 
MEL02400 
MEL02410 
MEL02420 
MEL02430 
MEL02440 
MEL02450 
MEL02460 
MEL02470 
MEL02480 
MEL02490 
MEL02500 
MEL02510 
MEL02520 
MEL02530 
MEL02540 
MEL02550 
MEL02560 
MEL02570 
MEL02580 
MEL02590 
MEL02600 
MEL02610 
MEL02620 
MEL02630 
MEL02640 
MEL02650 
MEL02660 
MEL02670 
MEL02680 
MEL02690 
MEL02700 
MEL02710 
MEL02720 
MEL02730 
MEL02740 
MEL02750 
MEL02760 
MEL02770 
MEL02780 
MEL02790 
MEL02800 
MEL02810 
MEL02820 
MEL02830 
MEL02840 
MEL02850 
MEL02860 
MEL02870 
MEL02880 
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REAL  NORTH, LOW 

INTEGER    P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS, 
SEP,H1,H2,H3,C1,C2,C3,C4,RX,RY,RZ,S1,S2 

INTEGER     P10,PP0,U10,U20,V10,V20,W10,W20,R10,R20,RS0, 
&EP0,H10,H20,H30,C10,C20,C30,C40,RX0,RY0,RZ0,S10,S20 

INTEGER     P1L,PPL,U1L,U2L,V1L,V2L,W1L,W2L,R1L,R2L,RSL, 
SEPL,H1L,H2L,H3L,C1L,C2L,C3L,C4L,RXL,RYL,RZL,S1L,S2L 

INTEGER     P1H,PPH,U1H,U2H,V1H,V2H,W1H,W2H,R1H,R2H,RSH, 
SEPH,H1H,H2H,H3H,C1H,C2H,C3H,C4H,RXH,RYH,RZH,S1H,S2H 

INTEGER  VOL, VOL 0, AEAST, ANORTH, AHIGH, AEDX, ANDY, AHDZ 

INTEGER  Dl , Dl DP , D2, D2DP , EXCO, CFP, HST1 , HST2 

INTEGER  D10, D20, D1L , D2L , EXCOL , D1H, D2H, EXCOH 

INTEGER  XG,XU,DXU,DXG,YG,YV,DYV,DYG,R,RV,ZG,ZW1,DZW, 
8DZCWGRID 

INTEGER  XPLANE,YPLANE,ZPLANE 

LOGICAL  LSLAB,MSLAB,HSLAB,LAMMU,LSPDA 

EQUIVALENCE  (Ml , Rl ) , (M2 , R2) 

SATLIT-EQUIVALENT  IRUN: 

EQUIVALENCE  ( IRUN, INTGRC 11 ) ) 
(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  1  ENDS. 
(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  1  STARTS: 

ARRAYS  (  DIMENSIONED  NY, NX  )  FOR  USE  NITH  'ADD': 

DIMENSION  CVAR(100,1),VVAR(100,1),CM(100,1),VM(100,1),ZERO(1,1) 

SPECIAL-DATA  ARRAYS  DIMENSIONED  8  DIMENSION  VALUES  SET  HERE: 

DIMENSION  LSPDA(1),ISPDA(1),RSPDA(1) 

USER  PLACES  HIS  VARIABLES,  ARRAYS,  EQUIVALENCES  ETC.  HERE. 

DIMENSION  GH1(100,1),  GC1 ( 1 00 , 1) , GC2( 100 , 1 ) , GC3( 100 , 1 ) 

DIMENSION  GH2(100,1),GD1U00,1),GD2(100,1),GR2(100,1) 

DIMENSION  GTEMP(100,1),GK0(3),GK1(3),GK2(3),  GK3C3),  GK4(3) 

DIMENSION  GM0(3),GM1(3),  GM2( 3) , GM3( 3 ) , GM4( 3) 

DIMENSION  GCP0(3),GCP1(3),  GCP2C  3  ) ,  GCP3(  3  ) ,  GCP4(4) 

DIMENSION  GK(3),  GM(3),  GCC 3) , GX( 3) , GW( 3 ) , GWI ( 100 , 1) 

DIMENSION  GD(4, 100,1;,  GVOL  ( 100  ,  1 )  ,  GV1  ( 100  ,  1 ) 

DIMENSION  GN(100,1),  GYP(100,1),  GYNV(100,1),  GAN(100,1) 

DIMENSION  GXO:i00,l),  GXMETC 100 , 1 ) , GGAMH1 ( 100 , 1) ,  GMDT(100,1) 

DIMENSION  GCPI(100,1),  GDD(4, 4) ,GVISC( 100, 1) 

DIMENSION  GCP(3,100),GTEMPO(10  0,1) 

NAMELIST  /MOLE/ATIME,GW,GWI 

NAMELIST  /TEMP/  ATIME, GTEMP, GXMET 

NAMELIST  /PROPM/  ATIME, GKMF, GCPMF, GROF, GFOX, GHFU, GHFGOX, GHFGM,GEW 

NAMELIST  /HT/GH2O0,GHOX0,GCPOX,GTMOX,GROOX,GLSOX,GT0XV,GTMVA,GTMM 

NAMELIST  /KSPEC/GK0,GK1,GK2,GK3,GK4 

NAMEL 1ST  /MUSPEC/GMO , GM1 , GM2 , GM3 , GM4 

NAMELIST/DDSPEC/  GDD 

NAMELIST  /CPSPEC/  GCPO , GCP1 , GCP2, GCP3, GCP4 

NAMELIST  /CPSPI/  ATIME, GCP, GCPI , GX 

NAMELIST  /SUMKUD/  GSUMK, GSUMU, GSUMD, GSUMF 

NAMELIST/YPV/  GVOL,GAN 

NAMELIST  /CINI/  ATIME, GC1 , GC2, GC3 

DATA  NLSP,NISP,NRSP/1,1,1/ 

DATA  CVAR,VVAR,CM,VM,ZERO/401XO.O/ 

USER  PLACES  HIS  DATA  STATEMENTS  HERE. 
(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  1  ENDS. 

GROUND   INPUT   FOR  METAL  COMBUSTION  MODEL 


DATA 
SO. 5, 

DATA 

DATA 
&    0 

DATA 
&  100 
a  0.0 

DATA 

a-1.3 

DATA 
8GK3( 
&2133 

SO.  ,0 
DATA 


JING,GTCR,GQOX,GBOX,GDOX,GNOX,GMOX/0,17  00.,3.E4,1. , 1 . E-6 , 
1/ 

GAQ,GKA/3.E5,1.0/ 

GFST,GFG,GEG,GNMI,GVP,GSIG,GA0,GAI,GC1MIN/ 
. 99843, 0. 111898, 0.0001, 4. E08, 3. 2E-8, 5. 668E-8, 0.5, 0.5, 0.001/ 

GPT, GKMF, GCPMF, GROF, GFOX, GHFU, GHFGOX, GHFGM, GH1M, GH3M, GEW/ 
000. ,121.3,1083.65,2340.,1.886532,4.45E07,4.728E06,1.13E07, 
973E07,1.378E07,0.09/ 

GH200,GHOXO,GCPOX,GTMOX,GROOX,GLSOX,GTOXV,GTMM,GTMVA/ 
1 E07,l. 6 43E07, 127 1.936, 2323. , 4000 ., 1 . 067 E06 , 3253 ., 900 . ,2323./ 

GK0(1),GK1(1),GK2(1),GK3C1),GK4(1),GK0(2),GK1(2),GK2(2), 
2 ) , GK4 ( 2 ) , GKO ( 3 ) , GK1 ( 3 ) , GK2 ( 3 ) , GK3 ( 3 ) , GK4 ( 3 ) / 

.33,26.54,0.,0.,0.,125490.,300.17  2,0.,0.,0.,-20915.,134.9,0., 
./ 

GMO ( 1) , GM1 ( 1) , GM2 ( 1 ) , GM3 ( 1) , GM4 ( 1) , GMO ( 2 ) , GM1 ( 2 ) , GM2 ( 2 ) , 


MEL02890 
MEL02900 
MEL02910 
MEL02920 
MEL02930 
MEL02940 
MEL02950 
MEL02960 
MEL02970 
MEL02980 
MEL02990 
MEL03000 
MEL03010 
MEL03020 
MEL03030 
MEL03040 
MEL03050 
MEL03060 
MEL03070 
MEL03080 
MEL03090 
MEL03100 
MEL03110 
MEL03120 
MEL03130 
MEL03140 
MEL03150 
MEL03160 
MEL03170 
MEL03180 
MEL03190 
MEL03200 
MEL03210 
MEL03220 
MEL03230 
MEL03240 
MEL03250 
MEL03260 
MEL03270 
MEL03280 
MEL03290 
MEL03300 
MEL03310 
MEL03320 
MEL03330 
MEL03340 
MEL03350 
MEL03360 
MEL03370 
MEL03380 
MEL03390 
MEL03400 
MEL03410 
MEL03420 
MEL03430 
MEL03440 
MEL03450 


MEL03460 
MEL03470 
MEL03480 
MEL03490 
MEL03500 
MEL03510 
MEL03520 
MEL03530 
MEL03540 
MEL03550 
MEL03560 
MEL03570 
MEL03580 
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&GM3 ( 3 ) , GM4 ( 2 ) , GMO ( 3 ) , GM1 ( 3 ) , GM2 ( 3 ) , GM3 ( 3 ) , GM4 ( 3 )/  MEL  0359  0 

&33., 0. 23395, 0.,0.,0., 100., 0.1 008857, 0.,0.,0., 56., 0. 2975, 0.,0.,0./  MEL 036 00 

DATA  GCP0(1),GCP1(1),GCP2(1),GCP3(1),GCP4(1),GCP0(2),GCP1(2),  MEL 036 10 

&GCP2(2),GCP3(2),GCP4(2),GCP0(3),GCP1(3),GCP2(3),GCP3(3),GCP4(3)/   MEL  036 20 

&  77  0.45,0.,0.,0.,0. ,2307.586  5,0.,0.,0. , 0 . , 16497 . 4, 0 . , 0 . , 0 . , 0 ./  MEL 036 30 

DATA  GW(1),GW(2),GW(3)/  26.98,18.016,2.01594/  MEL03640 

DATA  GDD(1,1),GDD(1,2),GDD(1,3),GDD(2,1),GDD(2,2),GDD(2,3),  MEL 03650 

8  GDD(3,1),GDD(3,2),GDD(3,3)/  MEL03660 

5  0.418,1.49,0.664,1.49,3.85,4.35,0.664,4.35,0.57/  MEL03670 
DATA  GTEMP/23X9 00. 0,150 0.0, 1500. 0,18 00. 0,3*2323. 0,2500.0,  MEL 03680 

6  2700.0,2900.0,3100.0,3500.0,3200.0,  3000.0,64*500.0/  MEL03690 
DATA  GTEMPO/  25*900 ., 10*2000 ., 25*900 ., 40*500 ./  MEL03700 
DATA  GXMET/26*0. 0,0. 5, 0.75, 72*1.0/  MEL03710 
IF  (ATIME  .GT.  0.0)  GOTO  2900  MEL03720 
PRINT  PROPM  MEL03730 
PRINT  HT  MEL03740 
PRINT  KSPEC  MEL03750 
PRINT  CPSPEC  MEL03760 
PRINT  MUSPEC  MEL03770 
PRINT  DDSPEC  MEL03780 
GTMJL=GTMVA  MEL03790 
GTMJS=GTMVA  MEL03800 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  2  STARTS:  MEL03810 

C     PLEASE  DO  NOT  ALTER,  OR  RE-SET,  ANY  OF  THE  REMAINING  MEL03820 

C     STATEMENTS  OF  THIS  SECTION.  MEL03830 

2900     IF(SPDATA)  MEL03840 

8CALL  RDSPC(IRN,INTGR(12),LSPDA,NLSP,ISPDA,NISP,RSPDA,NRSP)  MEL 03850 

CALL  GRDUTY(IRN,ICHAP,IZED,INDVAR)  MEL03860 

IFCICHAP.EQ.-5)  GO  TO  10  MEL03870 

IF(ICHAP.LE.0.OR.ICHAP.GT.16)  RETURN  MEL03880 

GO  TO  (100,200,300,400,500,600,700,800,900,1000,1100,1200,  MEL03890 

81300,1400,1500,16  0  0),ICHAP  MEL  039  00 

RETURN  MEL03910 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  2  ENDS.  MEL03920 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  2  STARTS:  MEL03930 

c MEL  03940 

C     CHAPTER  0:  MODIFY  SATLIT  DATA,  AT  START  OF  EACH  IRN.  MEL03950 

c MEL  0396  0 

10  CONTINUE  MEL03970 

C   END  OF  INITIAL  CONDITION  MEL03980 

C         IF( .NOT.NAMLST)  RETURN  MEL03990 

C         IF(IRN.EQ.NRUN)  DATFIL= . FALSE .  MEL04000 

C—   READ  SATLIT  DATA  NAMELIST  HERE  MEL04010 

C     CALL  WRIT40(40HENTER  NAMELIST  DATA  FOR  GROUPS  1  TO  24   )  MEL04020 

C     READ(20,G1G24)  MEL04030 

C     CALL  HRIT40(40HENTER  NAMELIST  DATA  FOR  GROUPS  25  TO  42  )  MEL04040 

C     READ(20,G25G42)  MEL04050 

RETURN  MEL04060 

c MEL  0407  0 

C     CHAPTER  1:  CALLED  AT  THE  START  OF  EACH  TIME  STEP.  MEL04080 

C     SET  *DT'  HERE  WHEN  TLAST  SET  NEGATIVE  IN  BLOCK  DATA.  MEL04090 

C      'ATIME  +  DT'  GIVES  THE  END  TIME  OF  THE  CURRENT  TIME  STEP.  MEL04100 

C     NOT  ACCESSED  IF  STEADY, OR  PARABOLIC.  MEL04110 

c MEL  041 20 

100  CONTINUE  MEL04130 

ATIME=ATIME+DT  MEL04140 

RETURN  MEL04150 

c MEL  0416  0 

C     CHAPTER  2:  CALLED  AT  THE  START  OF  EACH  SWEEP.  MEL04170 

c MEL  04180 

200  CONTINUE  MEL04190 

RETURN  MEL04200 

c MEL  04210 

C     CHAPTER  3:  CALLED  AT  THE  START  OF  EACH  SLAB;  MEL04220 

C     NOT  ACCESSED  IF  PARABOLIC,  BUT  'STRIDE'  IS.  MEL04230 

c MEL  04240 

300  CONTINUE  MEL04250 

RETURN  MEL04260 

c MEL  0427  0 

C     CHAPTER  4:  CALLED  AT  THE  START  OF  EACH  RE-CALCULATION  OF  MEL04280 

C     VARIABLES  P1,...C4  AT  CURRENT  SLAB.  ITNO=  ITERATION  NUMBER.  MEL04290 

c MEL  04300 
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DO  CONTINUE  MEL04310 

RETURN  MEL04320 

MEL  04330 

CHAPTER  5:  GROUND  CALLED  WHEN  SOURCE  TERM  IS  COMPUTED.  MEL04340 

INDVAR  GIVES  DEPENDENT  VARIABLE  IN  QUESTION  IE.  U1,...C4.  MEL04350 

TO  ADD  SOURCE  TO  DEPENDENT  VARIABLE  CKSAY)  FOR  IX=IXF,IXL  MEL04360 

AND  IY=IYF,IYL  INSERT  STATEMENT:  MEL04370 

IF(INDVAR.EQ.Cl)  MEL04380 

&CALL  ADD(  INDVAR,  IXF, IXL , IYF, IYL ,  TYPE,  CM,  VM,CVAR,  WAR,  NY,  NX)  MEL  0439  0 

NOTES  ON  'ADD':  MEL04400 

XS0URCE=  ( CVAR( IY, IX )+AMAXl ( 0.0, MASFLO ))X(VVAR(IY, IX) -PHI),  MEL  04410 

WHERE  'PHI»  IS  IN-CELL  VALUE  OF  VARIABLE  IN  QUESTION.  MEL04420 

X'MASFLO'=  CM(IY,IX)X(VM(IY,IX)-P),  MEL04430 

WHERE  »P'  IS  THE  IN-CELL  PRESSURE.  MEL04440 

xFOR  INDVAR=  Ml,  OR  =M2,  SOURCE  ADDED  IS  'MASFLO'  ONLY,  MEL04450 

EXCEPT  FOR  0NEPHS=.F.  S  MASFLO  <  0.0  (IE.  OUTFLOW)  WHEN  MEL04460 

CM(IY,IX)  IS  MULTIPLIED  BY  R1XD1  (FOR  Ml)  &  R2XD2  (FOR  M2) .  MEL04470 

XBOTH  'CVAR'  3  'CM'  ARE  MUTLIPLIED  BY  CELL-GEOMETRY  QUANTITY  MEL04430 

DICTATED  3Y  SETTING  OF  'TYPE'  (=CELL,  EAST  AREA ...  VOLUME) .  MEL04490 

XTYPE-SPECIFIED  AREAS  ARE  CALCULATED  AS  IF  BLOCKAGE  ABSENT,  MEL04500 

BUT  'VOLUME'  WITH  ACCOUNT  FOR  ITS  PRESENCE.  MEL04510 

XFOR  ALL  SOLVED  VARIABLES,  INCLUDING  Ml  (  3  M2  WHEN  ONEPHS=F),  MEL04520 

IF  »CM'>  0.0  CALL  'ADD';  FOR  Ml  8  M2  ALTHOUGH  'CVAR'  8  'WAR'  MEL04530 

HAVE  NO  SIGNIFICANCE  THEY  MUST  BE  ENTERED  AS  ARGUMENTS.  MEL04540 

X'CVAR',  'WAR',  'CM'  &  »VM'  MUST  BE  DIMENSIONED  NY, NX.  MEL04550 
MEL  0456  0 

)0  CONTINUE  MEL04570 

MEL04580 

(xxxxxxxxxxxxx   CHAPTER     5      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx  MEL04590 

MEL04600 

(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX*XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXMEL04610 

:OMPUTATION   OF   SMOKE  OXIDE  CLOUD  AND  METAL  SURFCE  LOCATION  AT  NEW  TMEL04620 

(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXMEL 0  4630 

CALL  GET(C1,GC1,NY,NX)  MEL04640 

CALL  GET(C2,GC2,NY,NX)  MEL04650 

CALL  GET(C3,GC3,NY,NX)  MEL04660 

CALL  GET(ANORTH,GAN,NY,NX)  MEL04670 

CALL  GET(R2,GR2,NY,NX)  MEL04680 

CALL  GET  (VOLO,GVOL,NY,NX)  MEL04690 

CALL  GET1D(YG,GYP,NY)  MEL04700 

CALL  GET1D(YV,GYNV,NY)  MEL04710 

CALL  GET  (MDT,GMDT,NY,NX)  MEL04720 

CALL  GET  (Dl, GDI, NY, NX)  MEL04730 

CALL  GET  (D2,GD2,NY,NX)  MEL04740 

CALL  GET(H1,GH1,NY,NX)  MEL04750 

CALL  GET(H2,GH2,NY,NX)  MEL04760 

CALL  GET(V1,GV1,NY,NX)  MEL04770 

PRINT  YPV  MEL04780 

IF  (  ATIME  .GT.  DT)  GOTO  2700  MEL04790 

JL=26  MEL04800 

JS=28  MEL04810 

3AS  PHASE  ZONE  PROPERTIES:  K,MU,  CPI,CP,D  MEL04820 

30  DO  2800  1=1, JL  MEL04830 

WRITE(6,x)  'xxxxxxxxxxxx  GTEMP=' ,GTEMP( I, 1) , I  MEL04840 

GT=GTEMP(I,1)  MEL04850 

GT2=GTXX2.  MEL04860 

GT3=GT2XGT  MEL04870 

GT4=GT3XGT  MEL04880 

GCPI(I,1)=GCPMF  MEL04890 

GWI(I,1)=GW(1)  MEL04900 

DO  2850  IN=1,3  MEL04910 

GCP(IN,I)=GCP0(IN)+GCP1(IN)XGT+GCP2(IN)XGT2+GCP3(IN)XGT3  MEL  04920 

S+GCP4(IN)XGT4  MEL04930 

50  CONTINUE  MEL04940 

DO  CONTINUE  MEL04950 

DO  60  I=JL,NY  MEL04960 

GT=GTEMP(I,1)  MEL04970 

GT2=GTXX2.  MEL04980 

GT3=GT2XGT  MEL04990 

GT4=GT3XGT  MEL05000 

IT=1  MEL05010 

DO  61  IN=1,3  MEL05020 
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61 


4000 
3000 


GK(IN)=GK0(IN)+GK1(IN)XGT+GK2(IN)XGT2+GK3(IN)XGT3+GK4(IN)XGT4 
GM(IN)=(GM0(IN)+GM1(IN)XGT+GM2(IN)XGT2+GM3(IN)XGT3+GM4(IN)XGT4)X 

ai.E-6 

GCP(IN,I)=GCP0(IN)+GCP1(IN)XGT+GCP2(IN)XGT2+GCP3(IN)XGT3 
8+GCP4(IN)XGT4 

CONTINUE 

GCPICI,1)=GCP(1,I)XGC1(I,1)+GCP(2,I)XGC2(I,1)+GCP(3,I)XGC3(I,1) 

KK  =  1 

IF((GW(1)XGW(2)XGW(3))  .GT.  1.0E-27)  GOTO  3000 

PRINT  400  0,KK,I,GW(1),GW(2),GW(3) 

F0RMAT(2I5,3F12.3) 

GWT=GC1(I,1)/GW(1)  +GC2(I,1)/GW(2)  +  GC3( I , 1 )/GWC 3) 

GWI(I,1)=1./GWT 

KK  =  2 

IF  (  GWI(I,1)  .GT.  l.E-27)  GOTO  3100 

PRINT  4000,KK,I,GWI(I,1),GWT 


XGTEMPCI,!)) 


3100  GX(1)=GC1(I,1)XGW(1)/GWI(I,1) 
GX(2)=GC2(I,1)XGW(2)/GWI(I,1) 
GX(3)=GC3(I,1)XGW(3VGWI(I,1) 

1/1/ =  T 

IF  (  GTEMP(I,1)  -GT.  1.0E-27  )  GOTO  3200 

PRINT  4000,KK,I,GTEMPCI,1) 
3200  GDl(I,l)=GPTxGWI(I,l)/(8483 

GD2(I,1)=GR00X 

GSUMK=0. 

GSUMU=0. 

DO  4  IN=1,3 

GSUMF=0. 

GSUMD=0. 

DO  5  IK=1,3 

KK  =  4 

IF(  GDD(IN,IK)  .GT.  l.E-27)  GOTO  3300 

PRINT  4000,KK,I,GDD(IN,IK) 
330  0  GSUMD=GSUMD+GX(IKV(GDD(IN,IK)XGTEMP(I,l)x*1.5) 

KK  =  5 

IFCCGMCIK)  x  GWCIKn.GT.  1.0E-27)  GOTO  3400 

PRINT  4000,KK,I,GM(IK),GW(IK) 
3400  GMM=GM(IN)/GM(IK) 

GNR=GW(IN)/GW(IK) 

GXNK=(1./SQRT(8X(1+GWR)))X(1+SQRT(GMM)/SQRT(SQRT(GWR)))XX2. 

GSUMF=GSUMF+GMMXGXNK 
5   CONTINUE 

KK  =  6 

if  (  gsumfxgsumdxgcpi(i,1)  . gt .  l.e-27)  goto  3500 

print  40  00,kk,i,gsumf,gsumd,gcpi(i,1) 
3500  gsumk=gsumk+gx(in)/gsumf 

gsumu=gsumu+gx(in)/gsumf 

gdini=gx(in)/gsumd 

gd(in,i,1)=gd1(i,1)xgdini 
4  continue 

ggamh1 ( 1,1) =gsumk/gcpi  (  1,1) 

gvisc(i,1)=gsumu 
60  continue 
:d   print  mole 
:d   print  cpspi 
:d   print  sumkud 
:d   print  cini 

JLL=JL-1 
DO  62  1=1, JLL 
I  FLUID  PHASE  PROPERTIES:  roo,  mu,  gamma=k/cp 
GD1(I,1)=GR0FXGCPMF/GCPICJL+1,1) 
GD2(I,1)=1.E-10 
GVISC(I,1)=  10000. 
GD(1,I,1)=1.E-10 


3600 
62 


GD(2,I,1)=1.E-10 

GD(3,I,1)=1.E-10 

KK  =  7 

IF  (  GCPMFXGTMVA 

PRINT  4000,KK,I,GCPMF,GTMVA 

GGAMH1 (1,1) =GKMF/GCPMF 

CONTINUE 


GT.  l.E-27)  GOTO  3600 


DENSITY  AT  THE  SUFACE  JL 


MEL05030 
MEL05040 
MEL05050 
MEL05060 
MEL05070 
MEL05080 
MEL05090 
MEL05100 
MEL05110 
MEL05120 
MEL05130 
MEL05140 
MEL05150 
MEL05160 
MEL05170 
MEL05180 
MEL05190 
MEL05200 
MEL05210 
MEL05220 
MEL05230 
MEL05240 
MEL05250 
MEL05260 
MEL05270 
MEL05280 
MEL05290 
MEL05300 
MEL05310 
MEL05320 
MEL05330 
MEL05340 
MEL05350 
MEL05360 
MEL05370 
MEL05380 
MEL05390 
MEL05400 
MEL05410 
MEL05420 
MEL05430 
MEL05440 
MEL05450 
MEL05460 
MEL05470 
MEL05480 
MEL05490 
MEL05500 
MEL05510 
MEL05520 
MEL05530 
MEL05540 
MEL05550 
MEL05560 
MEL05570 
MEL05580 
MEL05590 
MEL05600 
MEL05610 
MEL05620 
MEL05630 
MEL05640 
MEL05650 
MEL05660 
MEL05670 
MEL05680 
MEL05690 
MEL05700 
MEL05710 
MEL05720 
MEL05730 
MEL05740 
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GR0G=GPTXGWI(JL,1)XGC1(JL,1)/(GTMJLX8483.)  MEL05750 

KK=8  MEL05760 

IF  (  GROF*  GCPOXXGROG   . GT .  l.E-27)  GOTO  3700  MEL05770 

PRINT  4000, KK, I, GROF, GCPOX, GROG  MEL05780 

10  GD1(JL,1)  =  1./(1./GR0F+GXMET(JL  +  1,1)*(1./GR0G-1./GR0F))  MEL  0  57 9  0 

GD2(JL,1)=GR00X  MEL05800 
IECKING  IF  IGNITION  STARTS 

IF(  JIGN  .NE.  0)  GOTO  2750 

IF  (  GTEMP(JL,1)  .GE.  GTCR  )  GOTO  2710 
INITION  YET  NOT  STARTED 
1CULATTION  OF  HEATING  SOURCE  AT  THE  METAL  SURFACE 

DO  2720  IY=1,NY 

CM(IY,1)=0. 

VM(IY,l)+0. 

CVAR(IY,1)=1.E-10 

IF(  IY  .NE.  JL  )  GOTO  2720 

GD0XT=GB0XX(GC2(JL+l)xxGM0X/GD0XXXGN0X)*EXP(-GAQ/GTEMP(JL,l)) 
VVARCIY, 1)=GR00XXGQ0XXGD0XTX1 . E10 

GDOX=GDOX  +  GDOXTXDT 

0  CONTINUE 

CALL  ADD(H1,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX) 
GOTO  105 

MBUSTION  STAGE 

0  JIGN=1 

JSFLAG=0.  MEL05810 

JRFLAG  =0.  MEL05820 

GSUMN=0.  MEL05830 

GSUMV=0.  MEL05840 

DO  111  1=1, NY  MEL05850 

IY=NY-I+1  MEL05860 

GT=GTEMP(IY,1)  MEL05870 

GTEMPO(IY,1)=(GH2(IY,1)-GHOXO-GCPOXX298)/GCPOX  MEL  0  588  0 

GCPDT  =  GCPI(IY,l)X(GTEMP(IY,l)-298)  MEL  05390 

GCH20=GC2(IY,1)XGH200  MEL05900 

GCHFG=GC1(IY,1)X(GCP(1,IY)-GCPMF)  MEL  059 10 

KK=9  MEL05920 

IF  (  GVPXGCPMF  .GT.  l.E-27  )  GOTO  3800  MEL05930 

PRINT  4000,KK,I,GVP,GCPMF  MEL05940 

0  GN(IY,1)=GV0L(IY,1)XGR2(IY,1)/GVP  MEL05950 
IF  (  GN(IY,1)  .LT.  GNMI  )  GOTO  11  MEL05960 

0.  OF  OXIDE  PARTICLES  BECOME  SIGNIFICANT  MEL05970 

JCO=IY  MEL05980 

JRFLAG=1  MEL05990 

GOTO  12  MEL06000 

1  IF  (JRFLAG  .NE.  1)  GOTO  13  MEL06010 
IF  (GN(IY,1)  .GT.  GNMI)  GOTO  12  MEL06020 

.OF  OXIDE  PARTICLES  BECAME  INSIGNIFICANT  AGAIN,  GOING  OUT  OF  CLOUD   MEL06030 

JCI=IY  MEL06040 

JRFLAG=0.  MEL06050 

GOTO  13  MEL06060 

2  GSUMN=GSUMN+GN(IY,l)XGVOL(IY,l)  MEL06070 
GSUMV=GSUMV+GVOL(IY,l)  MEL06080 

3  IFC  GC1(IY,1)  .LE.  GC1MIN)  G0T018  MEL06090 
GPAL  =  (GC1(IY,1)XGWI(IY,1)/GW(1))XGPT  MEL  06 100 
GTMVA=  36560.8/(25. 016-ALOGCGPAL ) )  MEL06110 
GXMETA=(GH1(IY,1)-(GH1M+  GCPMFX(GTMVA-GTMM) )XGC1 ( IY, 1 )  -  MEL06120 

&  (GH200+  GCP(2,IY)X(GTMVA-373.0))XGC2(IY,1)  -                     MEL06130 

8  GCP(3,IY)X(GTMVA-298.0)XGC3(IY,1))/  (GHFGMXGC1 ( IY, 1 ) )  MEL06140 

IF(GXMETA  .LT.  0.0)  GXMETA=0.0  MEL06150 

IF  (  IY  .GT.  JS  )  GOTO  18  MEL06160 

IF  (  JSFLAG  .EQ.  0.)  GOTO  14  MEL06170 

GXMETA=(GH1(IY,1)-(GH1M+  GCPMFX(GTMJS-GTMM) )XGC1 ( IY, 1)  -  MEL06180 

8  (GH200+  GCP(2,IY)X(GTMVA-373.0))XGC2(IY,1)  -                     MEL06190 

8  GCP(3,IY)X(GTMVA-298.0)XGC3(IY,1))/  (GHFGMXGC1 ( IY, 1) )  MEL06200 

IF  (  JSFLAG  .GT.  1  )  GOTO  17  MEL06210 

FLAG  =  1   WHERE  0<=  X  =>1  MEL06220 

IF  (  GXMETA  .GT.  0.)  GOTO  20  MEL06230 

=0  FOR  THE  FIRST  TIME  MEL06240 

JL=IY  MEL06250 

JSFLAG=2  MEL06260 

GXMET(IY,1)=0.0  MEL06270 

GTMJL=GTMVA  MEL06280 
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GTMJS=GTMVA  MEL06290 

GTEMP(IY,1)=GTMJL  MEL06300 

GOTO  20  MEL06310 

17  GTEMP(IY,1)=(GH1(IY,1)-GH1M+GCPMF*GTMM)/GCPMF  MEL06320 

GXMET(IY,1)=0.0  MEL06330 

GOTO  111  MEL06340 

CHECKING  IF  SATURATION  OCCOURE  MEL06350 

14   KK=10  MEL06360 

IF  (GPTXGTMVAXGEW  . GT .  l.E-27)  GOTO  3900                        MEL06370 

PRINT  4000,KK,GPT,GTMVA,GEW  MEL06380 

3900   CONTINUE  MEL06390 

IF  (  GXMETA  .LE.  1  )   GOTO  19  MEL06400 

X>1,  GAS  PHASE  MEL06410 

18  GXMET(IY,1)=1.  MEL06420 
GTEMP(IY,1)=(GH1(IY,1)-(GH3M-GCP(I,IY)*GTMJS)*GC1(IY,1)  -  MEL  06  430 

8  (GH2O0-GCP(2,IY)*373.0)*GC2(IY,l)  +  GCP( 3 , IY)*298 • 0*GC3( IY, 1) )  /  MEL06440 

8  GCPI(IY,1)  MEL06450 

GOTO  111  MEL06460 

X<=1  ,FOR  THE  FIRST  TIME  AT  THIS  SWEEP  MEL06470 

19  JS=IY  MEL06480 
GTMJS=GTMVA  MEL06490 
JSFLAG=1  MEL06500 

20  GCPIF=GCPI(IY,1)-(GCPICIY,1)-GCPMF)XGC1(IY,1)  MEL06510 
IF  (  GCPIF  .GT.  l.E-10)  GOTO  22  MEL06520 
WRITE(6,X)'XXXGCPIF,GCPI,GC1,IY',GCPIF,GCPI(IY,1),GC1(IY,1),IY    MEL  06 530 

22    GTEMP(IY,1)=(GH1(IY,1)-(GH1M-GCPMFXGTMM+GXMETAXGHFGM)XGC1(IY,1)    MEL  06 540 

8  -  (GH200-GCP(2,IY)*373.0)*GC2(IY,1)+  GCP( 3, IY)XGC3( IY, 1 )X298 . 0 )   MEL06550 

8  /  GCPIF  MEL06560 

GXMET(IY,1)=  GXMETA  MEL06570 

111  CONTINUE  MEL06580 

PRINT  TEMP  MEL06590 

WRITE(6,X)'XXJL=  JS=',JL,JS, 'xxxTMJL  TMJS= * ,GTMJL ,GTMJS           MEL06600 

GTW=  GTEMP(JL,1)  MEL06610 

GTW4  =  GTWXX4  MEL06620 

IF  (  GSUMN  .LE.  l.E-10  )  GOTO  2950  MEL06630 

RADIATION  LOSES  FROM  THE  OXIDE  CLOUD  MEL06640 

KK=105  MEL06650 

IFCGSUMV  .GT.  l.E-27)  GOTO  5000  MEL06660 

PRINT  4000,KK,JCO,JCI,GSUMV  MEL06670 

5000  GNN=GSUMN/GSUMV  MEL06680 

GL=GYP(JCO,l)-GYP(JCI,l)  MEL  066 9  0 

GRC=GYP(JCI,1)+0.5XGL  MEL06700 

GEP=(4.E-12)XGNN  MEL06710 

GRPW=GYP(JL,1)  MEL06720 

GEP=1.-EXP(-GEPXGL)  MEL06730 

GFCW  =  1./(1./GEW+1./GEP-1)  MEL  067 40 

JC=(JC0+JCI)/2  MEL06750 

GTOX=GTEMP(JC,l)  MEL06760 

GT0X4=  GT0XXX4  MEL06770 

JG=(JC0+NY)/2  MEL06780 

GTG=GTEMP(JG,1)  MEL06790 

GTG4=GTGXX4  MEL06800 

GAP=GEP  MEL06810 

GSIG=5.6688E-8  MEL06820 

GA0=0.5  MEL06830 

GAI=0.5  MEL06840 
GRFC=(GAPX(GFCWXGAIXGEWXGTW4+GEGXGTG4XGA0+GEPX(1-GEW)XGFCWXGAIX    MEL  06850 

8  GT0X4)-GEPXGT0X4)*GSIG  MEL06860 

KK=106  MEL06870 

IFCGL  .GT.  1.0E-27  )  GOTO  5100  MEL06880 

PRINT  4000,KK,JCI,GL  MEL06890 

5100  GRCI=-GRFC/GL  MEL06900 

2950  CONTINUE  MEL06910 

WRITE(6,X)  'XXBEGIN  SOURCE, INDVAR  TIME  SWEEP' , INDVAR, ATIME, LSWEEP  MEL06920 

GOTO  (105,105,105,105,105,105,105,105,105,105,105,105,105,  MEL 06930 

8  401,501,105,601,701,801,105)  INDVAR  MEL06940 

SOURCE  TERM  FOR  C2  :  OXIDIZER  MEL06950 

701  DO  710  IY=2,NY  MEL06960 

CM(IY,1)=0.  MEL06970 

VM(IY,1)=0.  MEL06980 

CVAR(IY,1)=1.E-10  MEL06990 

GQ=GAQ/GTEMP(IY,1)  MEL07000 
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IF  (GQ  .GE.   5.  )  GQ=5.  MEL07010 

GKR=GKAXEXP(-GQ)  MEL07020 

GCDT=-3XGKRXGC2(IY,1)XX3.XGC1(IY,1)XX2.  MEL  07 030 

IF(  GV1(IY,1)  .LT.  0.0  )  GOTO  750  MEL07040 

GROU=(GD1(IY,1)+GD1(IY-1,1))X0.5XGV1(IY-1,1)  MEL  07  050 

GYN  =  GYP(IY,1)-GYP(IY-1,1)  MEL  07 06  0 

GR0U0X=GR0UX(GC2(IY,1)-GC2(IY-1,1))/GYN  MEL  07 07  0 

GOTO  740  MEL07080 

iO   GROU=(GD1(IY,1)+GD1(IY+1,1))X0.5XGV1(IY,1)  MEL07090 

GYN  =  GYP(IY+1,1)-GYP(IY,1)  MEL  07 100 

GR0U0X=GR0Ux(GC2(IY+l,l)-GC2(IY,l))/GYN  MEL07110 

iO   IF((ABS(GCDT)-ABS(GROUOX))  . GT .  l.E-5)  GOTO  720  MEL07120 

THE  REACTION  IS  CONTROLED  BY  THE  RATE  OF  REACTION.  MEL07130 

VVAR(IY,1)=GCDTX1.E10  MEL07140 

PRINT  4000, GCDT  MEL07150 

100  F0RMAT(5HGCDT=,F15.3)  MEL07160 

GMDT(IY,l)=-(l./3. )*VVAR(IY,1)*1.E-10  MEL  07 17  0 

GOTO  710  MEL07130 

'HE  REACTION  IS  CONTROLED  BY  DIFFUSION  FLUX.  MEL07190 

20  GF=GC1(IY,1)/GC2<IY,1)  MEL07200 

IFCGF  .LE.  GFST)  GOTO  730  MEL07210 

IIFFUSION FUEL  RICH.  MEL07220 

GROUOX=-ABS(GROUOX)  MEL07230 

GMDT(IY,1)=-GR0U0XXGF0X  MEL07240 

VVAR(IY,l)=GROUOXXl.E10  MEL07250 

PRINT  4100,GROUOX  MEL07260 

00  F0RMAT(7HGR0U0X=,F15.3)  MEL07270 
GOTO  710  MEL07280 

FUEL   LEAN  MEL07290 

30  VVAR(IY,1)=-ABS(GROUX(GC1CIY,1)-GC1(IY-1,1))/GYN)X1.E10  MEL 07 30  0 

GR0UC1=VVAR(IY,1)X1 .E-10  MEL  07 310 

PRINT  4200,GROUC1  MEL07320 

!00  F0RMAT(7HGR0UC1=,F15.3)  MEL07330 

10  CONTINUE  MEL07340 

VVAR(IY,1)=0.0  MEL07350 

CALL  ADD(C2,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX)  MEL07360 

WRITE(6,X)'XXC2,1,25,28,35,100',GC2  MEL  07 37  0 

WRITE(6,x)'VV    C2',VVAR  MEL07380 

WRITE(6,X)  'xxxxxx   END  SOURCE  ',INDVAR  MEL07390 

WRITE(6,X)  'XXENTHALPYSGHI  MEL07400 

RETURN  MEL07410 

MEL07420 

iOURCE  TERM  FOR  CI  i    FUEL  MEL07430 

01  DO  610  IY=2,NY  MEL07440 
CM(IY,1)=0.  MEL07450 
VM(IY,1)=0.  MEL07460 
CVAR(IY,1)=1.E-10  MEL07470 
GQ=GAQ/GTEMP(IY,1)  MEL07480 
IF  (GQ  .GE.  5.  )  GQ=5.  MEL07490 
GKR=GKAXEXP(-GQ)  MEL07500 
GCDT  =  -2XGKRXGC2(IY,1)XX3.XGC1(IY,1)XX2.  MEL  07 510 
IF(  GV1(IY,1)  -LT.  0.0  )  GOTO  650  MEL07520 
GR0U  =  (GD1(IY,1)+GD1(IY-1,1))X0.5XGV1CIY-1,1)  MEL  07530 

GYN  =  GYP(IY,1)-GYP(IY-1,1)  MEL  07 540 

GR0UCM  =  GR0UX(GC2(IY,1)-GC2(IY-1,1))/GYN  MEL  07 550 

GOTO  640  MEL07560 

iO   GR0U=(GD1(IY,1)+GD1(IY+1,1))X0.5XGV1(IY,1)  MEL07570 

GYN=GYP(IY+1,1)-GYP(IY,1)  MEL  07 58  0 

GR0UCM  =  GR0UX(GC2(IY+1,1)-GC2CIY,1))/GYN  MEL  07 590 

(0   IF((ABS(GCDT)-ABS(GROUCM))  . GT .  l.E-5)  GOTO  620  MEL07600 

THE  REACTION  IS  CONTROLED  BY  THE  RATE  OF  REACTION.  MEL07610 

VVAR(IY,1)=GCDTX1.E10  MEL07620 

GMDT(IY,1)=-(1./3.)XVVAR(IY,1)X1.E-10  MEL  07630 

GOTO  610  MEL07640 

rHE  REACTION  IS  CONTROLED  BY  DIFFUSION  FLUX.  MEL07650 

S20  GF=GC1(IY,1)/GC2(IY,1)  MEL07660 

IF(GF  .LE.  GFST)  GOTO  630  MEL07670 

)IFFUSION  FUEL  RICH.  MEL07680 

GR0U0X  =  -ABS(GR0UX(GC2(IY,1)-GC2(IY-1,1))/GYN)  MEL  076 90 

VVAR(IY,1)=GROUOXXGFSTX1.E10  MEL  077 0  0 

GOTO  610  MEL07710 

FUEL   LEAN  MEL07720 
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630  VVAR(IY,1)=-ABS(GR0UCM)X1.E1Q  MEL07730 

GMDT(IY,l)=-GROUCMXGFOX/GFST  MEL  077 40 

610  CONTINUE  MEL07750 

VVAR(IY,1)=0.0  MEL07760 

CALL  ADD(C1,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX)  MEL07770 

WRITE(6,X)'XXC1,1,25,28,35,100',GC1  MEL  0778  0 

WRITE(6,x)»VV  C1',VVAR  MEL07790 

WRITE(6,X)  'XXXXXX   END  SOURCE  MNDVAR  MEL07800 

HRITE(6,X)  'XXENTHALPY^GHI  MEL07810 

RETURN  MEL07820 

C  SOURCE  TERM  FOR  C3  :  HYDROGEN  GAS  PRODUCT  MEL07830 

801  DO  810  IY=2,NY  MEL07840 

CM(IY,1)=0.  MEL07850 

VM(IY,1)=0.  MEL07860 

CVAR(IY,1)=1.E-10  MEL07870 

GQ=GAQ/GTEMP(IY,1)  MEL07880 

IF  (GQ  .GE.   5.  )  GQ=5.  MEL07890 

GKR=GKA*EXPC-GQ)  MEL07900 

GCDT=-2*GKR*GC2(IY,1)XX3.XGC1(IY,1)XX2.  MEL  07  910 

IF(  GV1(IY,1)  .LT.  0.0  )  GOTO  850  MEL07920 

GROU=(GD1(IY,1)+GD1(IY-1,1))X0.5XGV1CIY-1,1)  MEL  07930 

GYN=GYP(IY,1)-GYP(IY-1,1)  MEL  07  940 

GR0UCM  =  GR0UX(GC2(IY,1)-GC2(IY-1,1))/GYN  MEL  07950 

GOTO  840  MEL07960 

850   GR0U=(GD1(IY,1)+GD1(IY+1,1))X0.5*GV1(IY,1)  MEL07970 

GYN=GYP(IY+1,1)-GYP(IY,1)  MEL  07 98  0 

GR0UCM=GR0UX(GC2(IY+1,1)-GC2CIY,1))/GYN  MEL  07 990 

840  IF((ABS(GCDT)-ABS(GROUCM))  . GT .  l.E-5)  GOTO  820  MEL08000 

C   THE  REACTION  IS  CONTROLED  BY  THE  RATE  OF  REACTION.  MEL08010 

VVAR(IY,1)=GCDTX1.E10  MEL08020 

GOTO  810  MEL08030 

C  THE  REACTION  IS  CONTROLED  BY  DIFFUSION  FLUX.  MEL08040 

820  GF=GC1(IY,1)/GC2(IY,1)  MEL08050 

IF(GF  .LE.  GFST)  GOTO  830  MEL08060 

C  DIFFUSION  FUEL  RICH.  MEL08070 

GR0U0X  =  -ABS(GR0UX(GC2(IY,1)-GC2(IY-1,1))/GYN)  MEL  08 080 

VVAR(IY,l)  =  -GROUOXXGFG*l.E10  MEL  08  09  0 

GOTO  810  MEL08100 

C   FUEL   LEAN  MEL08110 

830  VVAR(IY,1)=-ABS(GROUCM)*(GFG/GFST)X1.E10  MEL08120 

810  CONTINUE  MEL08130 

VVAR(IY,1)=0.0  MEL08140 

CALL  ADD(C3,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX)  MEL08150 

WRITE(6,*)'XXC3,1,25,28,35,100»,GC3  MEL  0816  0 

WRITE(6,X)"VV  C3SVVAR  MEL08170 

WRITE(6,X)  «xxxxxx   END  SOURCE  MNDVAR  MEL08180 

WRITE(6,X)  »XXENTHALPY',GH1  MEL08190 

RETURN  MEL08200 

C  HEAT  SORCE  TERM  FOR  HI  MEL08210 

401  DO  410  IY=1,NY  MEL08220 

CM(IY,1)=0.  MEL08230 

CVAR(IY,1)=1.E-10  MEL08240 

GT=GTEMP(IY,1)  MEL08250 

GPRP=GGAMH1(IY,1)  MEL08260 

GPRS=GGAMH1(IY-1,1)  MEL08270 

GPRN=GGAMH1(IY+1,1)  MEL08280 

GYNN=GYP(IY+1,1)-GYNV(IY,1)  MEL  08290 

KK=12  MEL08300 

IF(GAN(IY,1)  .GT.  l.E-27)G0T0  4200  MEL08310 

PRINT  4000,KK,IY,GAN(IY,1)  MEL08320 

4200  GYN=GYNV(IY,1)-GYP(IY,1)  MEL08330 

GYS  =  GYP(IY,1)-GYNV(IY-1,1)  MEL  08340 

GYSS  =  GYNV(IY-1,1)-GYP(IY-1,1)  MEL  08350 

GPRNX=GPRNX(1-GXMET(IY+1,1))  MEL  0836  0 

GPRPX  =  GPRPX(1-GXMET(IY,D)  MEL  0837  0 

GPRSX  =  GPRSX( 1-GXMETC IY-1 ,  1 )  )  MEL  08380 

GPRNC=GPRNXGC1(IY+1,1)  MEL08390 

GPRPC=GPRP*GC1(IY,1)  MEL08400 

GPRSC=GPRSXGC1(IY-1,1)  MEL08410 

KK=13  MEL08420 

IF(GPRNXXGPRPXXGPRSX  . GT .  l.E-27)  GOTO  4300  MEL08430 

PRINT  4000,KK,IY,GPRNX,GPRPX,GPRSX  MEL08440 
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4400 


4500 


GOTO  4600 


KK  =  14 

IF(GPRNC*GPRPC*GYNN  . GT .  l.E-27)  GOTO 

PRINT  4000,KK,IY,GPRNC,GPRPC,GYNN 

KK  =  15 

IF(GPRN*GPRP*GCP(1,IY+1)  • GT .  l.E-27)  GOTO 

PRINT  400  0,KK,IY,GPRN,GPRP,GCP(1,IY+1) 

KK  =  16 

IF(GPRSXGCP(1,IY-1)XGCP(2,IY)  . GT .  l.E-27) 

PRINT  40  0  0,KK,IY,GPRS,GCP(1,IY-1),GCP(2,IY) 

KK  =  17 

IF(GYSXGYSSxGCP(3,IY)  . GT .  l.E-27)  GOTO  4700 

PRINT  4000,KK,IY,GYS,GYSS,GCP(3,IY) 

KK  =  1 8 

IF(GCP(3,IY-l)xGPRNXGYN  . GT .  l.E-27)  GOTO  4800 

PRINT  4000,KK,IY,GCP(3,IY-1),GPRN,GYN 

IF  (  IY  .NE.  JL  )  GOTO  420 
OF  LIQUID  METAL 
THE  VALUE  OF  RADIATION  ABSORBED  AT  THE  SURFACE 

GRW=-GEW*GSIG*GTW4/GYN 

IF  C  GSUMN  .LE.  l.E-10  )  GOTO  460 

GRW=(GEPxGT0X4XGFCW+GEGxGTEMP((JL+JCI)/2,l)x*4)xGEW/GYN+GRW 
0  VVAR(IY,1)=GRW*1.E10 

GOTO  430 
0  IF((IY  .GT.  JS)  .OR.  (IY  .LT.  JL))  GOTO  430 
GION  WHERE   X<1  METAL  SATURETION 

GSXM1=(GC1(IY+1,1)-GC1CIY,1))/(GYNN/GPRNX+GYN/GPRPX)-(GC1(IY,1)- 
&GC1(IY-1,1))/(GYS/GPRNX+GYSS/GPRSX) 

GSXM2=(GXME7(IY+l,l)-GXMET(IY,l))/(GYNN/GPRNC+GYN/GPRPO- 
3  (GXMET(  IY, 1 )-GXMET( IY-1 , 1 ) )/(GYS/GPRPC+GYSS/GPRSC) 

GSXM=GHFGMX(GSXM2-GSXM1) 

VVAR(IY,1)=GSXM 
0  IF  (  IY  .LT.  JL  )  GOTO  440 


RFCE 
W  IS 


COMBUSTION  +  LATENT  (V3S)  HEAT   OF  OXIDE  IY>J 
BY  VAPOR  PHASE   OXIDE  CHANGE  TO  LIQUID  OXIDE 
BY  LIQUID  PHASE   OXIDE  CHANGE  TO  SOLID  OXIDE 


GHOXV=GMDT(IY,l)XGHFGOX 
GHOXV=GHOXV+  GR00XXGR2( IY, 1 )X 

GHOXS=GMDT(IY,l)*GLSOX 
GHOXS=GHOXS+  GR00X*GR2( IY, 1 )x 


EAT   RELEASED  BY  METAL 
HOXV  FOR  HEAT  RELEASED 
HOXS  FOR  HEAT  RELEASED 
GHOXV=0.0 
GHOXS=0. 

IF  (GTEMP(IY,1)  .LE.  GTOXV) 
IF(GTEMPO(IY,l)  .LE.  GTOXV) 
&GVOL(IY,l)*GHFGOX 
IF  (GTEMP(IY,1)  .LE.  GTMOX) 
IF(GTEMPO(IY,l)  .LE.  GTMOX) 
3GV0L(IY,1)XGLS0X 
VVAR(IY,1)=VVAR(IY,1)+GMFUXGHFU  +  GHOXS  +  GHOXV 
AT  TRANSFERED  BY  CONVECTION  TO  THE  GAS  FROM  THE  OXIDE  PARTICLES 
GAS=3.*GR2(IY,l)/2.E-6 

VVAR(IY,1)=VVAR(IY,1)+(5.23E06)XGASX(GTEMPO(IY,1)-GTEMP(IY,1)) 
RRECTION  OF  HEAT  SOURCE  DUE  TO  ENTHALPY  CONDUTION 

GDHM=(GC1(IY+1,1)-GC1(IY,1))/(GYNN/GPRNXGCP(1,IY+1)+GYN/(GPRPX 
&GCP(l,IY)))-(GCl(IY,l)-GCl(IY-l,l))/(GYS/(GPRPXGCP(l,IY))+GYSS/( 
SGPRSXGCP(1,IY-1))) 

GDH2=CGC2(IY+1,1)-GC2(IY,1))/(GYNN/(GPRNXGCP(2,IY+1))+GYN/CGPRP 
&XGCP(2,IY)))-(GC2(IY,1)-GC2(IY-1,1))/(GYS/(GPRPXGCP(2,IY))+ 

5  GYSS/(GPRS*GCP(2,IY-1))) 
GDH20=(GC3(IY+1,1)-GC3(IY,1))/(GYNN/(GPRNXGCP(3,IY+1))+GYN/(GPRPX 

8GCP(3,IY)))  -  (GC3(IY,1)-GC3(IY-1,1))/(GYS/(GPRPXGCP(3,IY))+GYSS/ 

6  (GPRSXGCP(3,IY-1))) 

GH20=  (  GC3(IY+1,1)-GC3(IY,1))/(GYNN/GPRN+GYN/GPRP)  - 
&  (GC3(IY,1)-GC3(IY-1,1))/(GYS/GPRP+GYSS/GPRS) 

VVAR(IY,1)=VVARCIY,1)+(GDHM+  GDH2  +GDH20)*(GT-298 )+  GH200XGH20 

GOTO  450 
AT  SOURCE  IN  METAL  .  NO  HEAT  GNERATEDAT  THIS  RIGION  IY<JL. 
0  VVAR(IY,1)=0.0 
0  VVAR(IY,1)=VVARCIY,1)X1.E10 
0  CONTINUE 

CALL  ADD(H1,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX) 

WRITE(6,X)'xxxHl',GHl 

WRITE(6,X)'XXTEMP',GTEMP 

WRITE(6,x)'xx  HI  SOURE',VVAR 

WRITE(6,X)  »xxxxxx   END  SOURCE  ',INDVAR 

RETURN 
AT  SOURCES  ON   THE  OXIDE  PHASE  H2 


MEL08450 
MEL08460 
MEL08470 
MEL08480 
MEL08490 
MEL08500 
MEL08510 
MEL08520 
MEL08530 
MEL08540 
MEL08550 
MEL08560 
MEL08570 
MEL08580 
MEL03590 
MEL03600 
MEL08610 
MEL08620 
MEL08630 
MEL08640 
MEL03650 
MEL08660 
MEL08670 
MEL08630 
MEL08690 
MEL037C0 
MEL08710 
MEL08720 
MEL08730 
MEL08740 
MEL08750 
MEL08760 
MEL03770 
MEL08780 
MEL08790 
MEL08300 
MEL08810 
MEL08820 
MEL08830 
MEL08840 
MEL08850 
MEL08860 
MEL08870 
MEL08880 
MEL08890 
MEL08900 
MEL08910 
MEL08920 
MEL08930 
MEL08940 
MEL08950 
MEL08960 
MEL08970 
MEL08980 
MEL08990 
MEL09000 
MEL09010 
MEL09020 
MEL09030 
MEL09040 
MEL09050 
MEL09060 
MEL09070 
MEL09080 
MEL09090 
MEL09100 
MEL09110 
MEL09120 
MEL09130 
MEL09140 
MEL09150 
MEL09160 


27 


FILE:  MEL3GRD   FORTRAN   Al 

501  DO  510  IY=1,NY  MEL09170 

KK=19  MEL09180 

IF(  GCPOXXGCPI(IY,l)*GVOL(IY,l)  .GT.  l.E-27)  GOTO  4900  MEL09190 

PRINT  4000,KK,IY,GCPOX,GCPI(IY,1),GVOL(IY,1)  MEL09200 

4900  CM(IY,1)=0.  MEL09210 

VM(IY,1)=0.  MEL09220 

GHOXS=0.0  MEL09230 

CVAR(IY,1)=1.E-10  MEL09240 

VVAR(IY,1)=0.  MEL09250 

510  CONTINUE  MEL09260 

DO  520  IY=JL,NY  MEL09270 

GAS=3.xGR2(IY,l)/2.E-6  MEL09280 

C  HEAT  LOSES  BY  CONVECTION  TO  THE  GAS  PHASE  MEL09290 

VVAR(IY,1)=-(5.23E6)XGASX(GH2(IY,1)XGCP(IY,1)-GH1(IY,1)XGCP0X+     MEL  09300 

S  GCPOXX(GC3(IY,l)*GH2O0)-GCPICIY,l)*GHOX0)/(GCPOX*GCPI(IY,l))  MEL  09310 

IF(C(GTEMPO(IY,l)-GTMOX)  .LT.  3)  .OR.  (GTEMP(IY,1)  .LE.  GTMOX))    MEL09320 

8  GH0XS=GR0OXXGR2(IY,l)XGVOL<IY,l)XGLSOX  MEL09330 

C  SOLDIFICATION  OF  OXIDE  -  HEAT  LOSES  TO  GAS  PHASE  MEL09340 

VVAR(IY,l)=VVAR(IY,l)-GHOXS  MEL  09350 

C  RADIATION  HEAT  LOSES  MEL09360 

IF((  IY  .GE.JCI)  .AND.  (  IY  .LE.  JCO))  VVAR< IY, 1 ) =VVAR( IY, 1 )-GRCI  MEL09370 

C  CONTRIBUTION  OF  HEAT  GENERATED  BY  NEW  OXIDE  COMBUSTION  PRODUCT  MEL09380 

VVAR(IY,l)=VVAR(IY,l)+GMDT(IY,l)XGCPOXx(GTOXV-GTEMPO(IY,l))/  MEL  09390 

&GVOL(IY,l)  MEL09400 

VVAR(IY,1)=VVAR(IY,1)X1.E10  MEL  09410 

520  CONTINUE  MEL09420 

CALL  ADD(H2,1,NX,1,NY,V0LUME,CM,VM,CVAR,VVAR,NY,NX)  MEL09430 

WRITE(6,X)«xxxH2«,GH2  MEL09440 

WRITE(6,X)'XXTEMP  0X',GTEMP0  MEL09450 

WRITE(6,x)'xx  H2  SOURESVVAR  MELQ9460 

WRITE(6,x)  'xxxxxx   END  SOURCE  ',INDVAR  MEL09470 

105  RETURN  MEL09480 

CxxxxxxxxxxxxxxxEND   QF  CHAPTER  5   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxmel 09490 

c MEL  09 50  0 

C      CHAPTER  6:  CALLED  AT  THE  END  OF  EACH  VARIABLE-RECALCULATION  MEL09510 

C     CYCLE  COMMENCED  AT  CHAPTER  4.  ITNO  =  ITERATION  NUMBER.  MEL09520 

c MEL  09530 

600  CONTINUE  MEL09540 

RETURN  MEL09550 

c MEL  0956  0 

C     CHAPTER  7:  CALLED  AT  END  OF  EACH  SLAB-WISE  CALCULATION.  MEL09570 

c MEL  09580 

700  CONTINUE  MEL09590 
Cxxxxxxxxxxxxxxx  CHAPER   7    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxMEL09600 

CALL  SET(U2,1,NX,1,NY,GTEMP,NY,NX)  MEL09610 

CALL  SET(U1,1,NX,1,NY,GTEMP0,NY,NX)  MEL09620 

DO  106  1=1, NY  MEL09630 

IF(MSLAB)  GOTO  107  MEL09640 

JC1=C1H  MEL09650 

JC2=C2H  MEL09660 

JC3=C3H  MEL09670 

GOTO  108  MEL09680 

107   JC1=C1  MEL09690 

JC3=C3  MEL09700 

JC2=C2  MEL09710 

108  CALL  GETUC1,GC1,NY,NX)  MEL09720 
CALL  GET(JC2,GC2,NY,NX)  MEL09730 
CALL  GET(JC3,GC3,NY,NX)  MEL09740 
IF(  I  .GT.JL)  GOTO  109  MEL09750 
GC1(I,1)=1.0  MEL09760 
GC2(I,1)=0.0  MEL09770 
GC3(I,1)=0.0  MEL09780 
GOTO  106  MEL09790 

109  IF  (GC1(I,1)  .GT.1.0)GC1CI,1)=1.0  MEL09800 
IF  (GC2(I,1)  .GT.1.0)GC2(I,1)=1.0  MEL09810 
IF  (GC3(I,1)  .GT.1.0)GC3(I,1)=1.0  MEL09820 
IF  (GC1(I,1)  .LT.  0.0)GC1(I,1)=0.0  MEL09830 
IF  (GC2(I,1)  .LT.  0.0)GC2(I,1)=0.0  MEL09840 
IF  (GC3(I,1)  .LT.  0.0)GC3(I, 1)=0.0  MEL09850 

106   CONTINUE  MEL09860 

CALL  SET(JC1,1,NX,1,NY,GC1,NY,NX)  MEL09870 

CALL  SET(JC2,1,NX,1,NY,GC2,NY,NX)  MEL09880 
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CALL  SETUC3,1,NX,1,NY,GC3,NY,NX)  MEL09890 

RETURN  MEL09900 

MEL  099 10 

CHAPTER  8:  CALLED  AT  THE  END  OF  EACH  SWEEP;  MEL09920 

NOT  ACCESSED  IF  PARABOLIC.  MEL09930 

MEL 09940 

100  CONTINUE  MEL09950 

RETURN  MEL09960 

MEL  09  97  0 

CHAPTER  9:  CALLED  AT  THE  END  OF  EACH  TIME  STEP;  MEL09980 

NOT  ACCESSED  IF  PARABOLIC.  MEL09990 

MEL  10000 

100  CONTINUE  MEL10010 

RETURN  MEL10020 

MEL  10 030 

CHAPTER  10:  SET  PHASE  1  DENSITY  HERE  WHEN  IRH01=-1  IN  DATA.  MEL10040 
SET  CURRENT-Z  'SLAB1  DENSITY,  Dl ,  IF  MSLAB=.T.,  MEL10050 
EG.  IF(MSLAB)  CALL  SETC Dl , 1 , NX, 1 , NY, GDI , NY, NX) .  MEL10060 
SET  NEXT  LARGER-Z  'SLAB*  DENSITY,  D1H,  IF  HSLAB=.T.  8  PARAB=F  MEL10070 
EG.  IF(HSLAB)  CALL  SETC D1H, 1 , NX, 1 , NY, GD1H, NY, NX) .  MEL10080 
SET  D(LN(D1))/DP  (IE.  D1DP)  FOR  UNSTEADY  FLOW,  MEL10090 
EG.  IF(MSLAB)  CALL  SETC D1DP, 1 , NX, 1 , NY, GD1DP, NY, NX) .  MEL10100 
MEL  101 10 

00  CONTINUE  MEL10120 
ixxxxxxxxxxxxxCHAPTER   10     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxMEL10130 

IF  (MSLAB)  GOTO  101  MEL10140 

JD1=D1H  MEL10150 

GOTO  102  MEL10160 

01  JD1=D1  MEL10170 

02  CALL  SETCJD1,1,NX,1,NY,GD1,NY,NX)  MEL10180 
RETURN  MEL10190 

MEL  1020  0 

CHAPTER  11:  SET  PHASE  2  DENSITY  HERE  WHEN  IRH02=-1  IN  DATA.  MEL10210 
SET  CURRENT-Z  'SLAB'  DENSITY,  D2,  IF  MSLAB=.T.,  MEL10220 
EG.  IFCMSLAB)  CALL  SETC D2, 1 , NX, 1 , NY, GD2, NY, NX) .  MEL10230 
SET  NEXT  LARGER-Z  'SLAB'  DENSITY,  D2H,  IF  HSLAB=.T.  &  PARAB=F  MEL10240 
EG.  IFCHSLAB)  CALL  SETC D2H, 1 , NX, 1 , NY, GD2H, NY, NX) .  MEL10250 
SET  DCLNCD2))/DP  FOR  UNSTEADY  FLOW,  MEL10260 
EG.  IFCMSLAB)  CALL  SETC D2DP, 1 , NX, 1 , NY, GD2DP, NY, NX) .  MEL10270 
MEL  1028  0 

00  CONTINUE  MEL10290 

ixxxxxxxxxxx  CHAPTER  11      xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx  MEL10300 

IF  (MSLAB)  GOTO  103  MEL10310 

JD2=D2H  MEL10320 

GOTO  104  MEL10330 

03  JD2=D2  MEL10340 

04  CALL  SETCJD2,1,NX,1,NY,GD2,NY,NX)  MEL10350 
RETURN  MEL10360 

MEL  1037  0 

CHAPTER  12:  SET  PHASE  1  VISCOSITY  HERE  WHEN  IEMU1=-1  IN  DATA.  MEL10380 

SET  CURRENT-Z  'SLAB'  VISCOSITY  CMU1),  IF  MSLAB=.T.,  MEL10390 

EG.   IFCMSLAB)  CALL  SETCMU1 , 1 , NX, 1 , NY, GVISC, NY, NX) .  MEL10400 

SET  NEXT  LARGER-Z  'SLAB'  VISC.  CMU1H),  IF  HSLAB=.T.  &  PARAB=F  MEL10410 

EG.   IFCHSLAB)  CALL  SET(MU1H, 1 , NX, 1 , NY,GVSCH, NY, NX) .  MEL10420 

MEL10430 
CHAPTER  ALSO  ACCESSED  WHEN  EMULAM=-1.0  IN  DATA,  SO  THAT  THE  MEL10440 
LAMINAR  VISCOSITY  WHICH  APPEARS  IN  WALL  FUNCTIONS  8  IN  THE  MEL10450 
KE-EP  TURBULENCE  MODEL  (IEMU1=2)  MAY  BE  SET  NON-CONSTANT.  MEL10460 
SET  CURRENT-Z  'SLAB'  VALUE  (MU1LAM)  WHEN  LAMMU=.T.,  MEL10470 
EG.  IF(LAMMU)  CALL  SET(MU1LAM, 1 , NX, 1 , NY, GVSCL , NY, NX) .  MEL10480 
MEL  10490 

!00  CONTINUE  MEL10500 
exxxxxxxxxxx  CHAOTER  12  xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx  MEL10510 
IF(MSLAB)  CALL  SET(MU1 , 1 , NX, 1 , NY, GVISC, NY, NX)  MEL10520 
IF  (HSLAB)  CALL  SET(MU1H, 1 , NX, 1 , NY, GVISC, NY, NX)  MEL10530 
IF  (LAMMU)  CALL  SET(  MU1LAM, 1 , NX, 1 , NY, GVISC, NY, NX)  MEL10540 
RETURN  MEL10550 
MEL  1056  0 

CHAPTER  13:  SET  EXCHANGE  COEFFICIENT  (E.C.)  FOR  VARIABLE  MEL10570 

INDVAR  WHEN  SIGMA( INDVAR) =-1 . 0  IN  DATA.  MEL10580 

SET  CURRENT-Z  'SLAB'  E.C.  (EXCO)  IF  MSLAB=.T.,  MEL10590 

EG.   IF(MSLAB)  CALL  SET( EXCO, 1 , NX, 1 , NY, GEXCO, NY, NX) .  MEL10600 
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SET  NEXT  SMALLER-Z  'SLAB'  E.C.  (EXCOL)  IF  LSLAB=.T., 

EG.   IF(LSLAB)  CALL  SET( EXCOL , 1 , NX, 1 , NY, GEXCOL , NY, NX) . 

SET  NEXT  LARGER-Z   'SLAB'  E.C.  (EXCOH)  IF  HSLAB=.T., 

EG.   IF(HSLAB)  CALL  SET( EXCOH, 1 , NX, 1 , NY, GEXCOH, NY, NX) . 

NOTE:  FOR  MSLAB,  INDVAR=U1 , . . C4;  FOR  LSLAB,  INDVAR=U1L , . . C4L 

8  FOR  HSLAB,  INDVAR=U1H, . . C4H .  IF  PARAB=.T.  SET  MSLAB  ONLY. 


C 

C 

C 

C 

C 

C 

c 

1300  CONTINUE 
C  xxxx*xxxx*xx   CHAPTER  13     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 
IF(  INDVAR  .NE.H1)  GOTO  131 

IF  (LSLAB)  CALL  SETC EXCOL , 1 , NX, 1 , NY, GGAMH1 , NY, NX) 
IF  (MSLAB)  CALL  SET( EXCO, 1 , NX, 1 , NY, GGAMH1 , NY, NX) 
IF  (HSLAB)  CALL  SET( EXCOH, 1 , NX, 1 , NY, GGAMH1 , NY, NX) 

131  IF  (INDVAR  .NE.C1)  GOTO  132 

IF  (LSLAB)  CALL  SET( EXCOL , 1 , NX, 1 , NY, GD( 1 , NY, 1 ) , NY, NX) 

IF  (MSLAB)  CALL  SET( EXCO, 1 , NX, 1 , NY, GD( 1 , NY, 1 ) , NY, NX) 

IF  (HSLAB)  CALL  SET( EXCOH , 1 , NX, 1 , NY, GD( 1 , NY, 1 ) , NY, NX) 

132  IF(  INDVAR  ,NE.  C2)  GOTO  133 

IF  (LSLAB)  CALL  SET( EXCOL , 1 , NX, 1 , NY, GD( 2, NY, 1 ) , NY, NX) 
IF  (MSLAB)  CALL  SET( EXCO, 1 , NX, 1 , NY, GD( 2, NY, 1 ) , NY, NX) 
IF  (HSLAB)  CALL  SET( EXCOH, 1 , NX, 1 , NY, GD(2, NY, 1 ) , NY, NX) 

133  IF  (INDVAR  .NE.C3  )  GOTO  134 

IF  (LSLAB)  CALL  SET( EXCOL , 1 , NX, 1 , NY, GD( 3, NY, 1 ) , NY, NX) 
IF  (MSLAB)  CALL  SET( EXCO, 1 , NX, 1 , NY, GD( 3, NY, 1 ) , NY, NX) 
IF  (HSLAB)  CALL  SET( EXCOH, 1 , NX, 1 , NY, GD(3, NY, 1 ) , NY, NX) 

134  RETURN 

c 

C     CHAPTER  14:  SET  INTER-PHASE  FRICTION  COEFFICIENT  (CFP)  HERE 

C     WHEN  ICFIP  =  -1  IN  DATA;  ITS  UNITS  =  FORCE  /  (CELL  *  RELATIVE 

C     SPEED  OF  PHASES). 

c 

1400  CONTINUE 

RETURN 
c 

C     CHAPTER  15:  SET  INTER-PHASE  MASS-TRANSFER  RATE  PER  CELL  (MDT) 

C     HERE  WHEN  IMDOT  =  -1  IN  DATA. 

c 

1500  CONTINUE 
C  xxxxxxxxxxxx  CHAPTER   15    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 
CALL  SET(MDT,1,NX,1,NY,GMDT,NY,NX) 
RETURN 


CHAPTER  16:  SET  HERE  PHASE  1  &  2  SATURATION  ENTHALPIES 
(  HST1  8  HST2)  WHEN  IHSAT  =  -1  IN  DATA. 


1600  CONTINUE 

RETURN 

END 
C$DIRECTIVE**STRIDE 

SUBROUTINE  STRIDE( IZSTEP, IGOTO, IRN) 
c 

C 

c 

c 

c 

c 

c 

c- 

c$ 


USE  THIS  SUBROUTINE  TO  SPECIFY  THE  GEOMETRY 

OF  THE  FORWARD  STEP  IN  PARABOLIC  CALCULATIONS. 

IZSTEP  IS  THE  CURRENT  FORWARD  STEP,  S  NZSTP  IS  THE  LAST 

FORWARD  STEP  (FOR  PARAB=.T.  EARTH  SETS  NZ=1  ). 

THE  COMMON  VARIABLE  »ZWL'  GIVES  THE  DISTANCE  OF  THE 

PREVIOUS  STEP  FROM  THE  ORIGIN. 

INCLUDE  9,CMNGUSSI.FTN/G 

LOGICAL  LOGIC1, LOGIC 

DIMENSION  LOGIC(IOO) 

C0MM0N/LDATA/L0GICK309) 

EQUIVALENCE  ( LOGIC( 1 ) , LOGIC1 (210) ) 

DIMENSION  INTGR(IOO) 

COMMON/I DATA/INTGRK 194) 

EQUIVALENCE  ( INTGR( 1 ) , INTGR1 (95)  ) 

DIMENSION  RE(IOO) 

C0MM0N/RDATA/REK421) 

EQUIVALENCE  ( RE( 1 ) , RE1 ( 322) ) 

COMMON/ BOUND/ L0CREG(60), 
8TR1,CP1R1(7),VP1R1(7),CP2R1(5),VP2R1(5),CPNR1(5),VPNR1(5), 
8TR2,CP1R2(7),VP1R2(7),CP2R2(5),VP2R2(5),CPNR2(5),VPNR2(5), 


MEL10610 
MEL10620 
MEL10630 
MEL10640 
MEL10650 
MEL10660 
MEL10670 
MEL10680 
MEL10690 
MEL10700 
MEL10710 
MEL10720 
MEL10730 
MEL10740 
MEL10750 
MEL10760 
MEL10770 
MEL10780 
MEL10790 
MEL10800 
MEL10810 
MEL10820 
MEL10830 
MEL10840 
MEL10850 
MEL10860 
MEL10870 
MEL10880 
MEL10890 
MEL10900 
MEL10910 
MEL10920 
MEL10930 
MEL10940 
MEL10950 
MEL10960 
MEL10970 
MEL10980 
MEL10990 
MEL11000 
MEL11010 
MEL11020 
MEL11030 
MEL11040 
MEL11050 
MEL  11 06  0 
MEL11070 
MEL11080 
MEL11090 
MEL11100 
MEL11110 
MEL11120 
MEL11130 
MEL11140 
MEL11150 
MEL11160 
MEL11170 
MEL11180 
MEL11190 
MEL11200 
MEL11210 
MEL11220 
MEL11230 
MEL11240 
MEL11250 
MEL11260 
MEL11270 
MEL11280 
MEL11290 
MEL11300 
MEL11310 
MEL11320 
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aTR3,CPlR3(7),VPlR3(7),CP2R3(5),VP2R3(5),CPNR3(5),VPNR3(5),  MEL  11 330 

8TR4,CP1R4(7),VP1R4(7),CP2R4(5),VP2R4(5),CPNR4(5),VPNR4(5),  MEL  11 340 

STR5,CP1R5(7),VP1R5(7),CP2R5(5),VP2R5(5),CPNR5(5),VPNR5(5),  MEL  11 350 

8TR6,CP1R6(7),VP1R6(7),CP2R6(5),VP2R6(5),CPNR6(5),VPNR6(5),  MEL  11 36  0 

aTR7,CPlR7(7),VPlR7(7),CP2R7(5),VP2R7(5),CPNR7(5),VPNR7(5),  MEL  11 37  0 

8TR8,CP1R8(7),VP1R8(7),CP2R8(5),VP2R8(5),CPNR8(5),VPNR8(5),  MEL  11 38  0 

8TR9,CP1R9(7),VP1R9(7),CP2R9(5),VP2R9(5),CPNR9(5),VPNR9(5),  MEL  11 39  0 

8TR10,CP1R10(7),VP1R10(7),CP2R10(5),VP2R10(5),CPNR10(5),VPNR10(5)   MEL  11400 

DIMENSION  TCVREG(350)  MEL11410 

EQUIVALENCE  (TCVREG( 1 ) , TR1 )  MEL11420 

NCLUDE  9,GUSSEQUI.FTN/G  MEL11430 

LOGICAL  CARTES, POLAR, SPDATA, SKEW, TWODYZ, ONEDZ, STOVAR( 25),  MEL  11440 

8    S0LVAR(25),PRINT(25),RESID(25),CMPRSS,C0NEMU,LSP1,  MEL11450 

&    CONRHO,EMDOT,ONEPHS,INCORE(10),ISAVED,SAVEI,SAVEM,  MEL11460 

8    RESTRT,XCYCLE,MONITR,REGION(10),STEADY,WHOLEP,SLABPP,  MEL  11 47  0 

8    RAIN, BLOCKZ,PWSTAG,RUN(30), PLOT, RESMAP, FLAG, BLOCK,  MEL11430 

8    TEST, C0NCK4), DISTIL  MEL11490 

LOGICAL  SPRESS,PARAB,DONACC, OVERLY, SACC,  MEL11500 

8    GUSSIE, CATHY, CONNIE, CORA, ESTER, FLASH, FLORA,  MEL11510 

8    FOCS,GENMIX, HESTER, PICALO, PLANT, SPLASH, HELGA,  MEL11520 

8    TACT, TIBALT,TOPSI, PAMELA, TABLES, WSTAG,  MEL11530 

8    CONMOD,GROSTA,SUBPST,SUBWGR  MEL11540 

EQUIVALENCE  (CARTES, LOGIC1 ( 1) ),( POLAR, LOGIC1 ( 2) ) ,  MEL11550 

8    (SPDATA, LOGIC1 (3)), (SKEW, LOGIC1 (4)), (TWODYZ, L0GICK5)),  MEL  11 56  0 

8    (ONEDZ, L0GIC1(6)),(ST0VAR(1),L0GIC1(7)),  MEL11570 

8    (SOLVAR(1),LOGIC1(32)),(PRINT(1),LOGIC1(57)),  MEL11580 

8    (RESID(1),LOGIC1(32)),(CMPRSS,LOGIC1(107)),  MEL11590 

8    (CONEMU,LOGIC1(108)),(LSP1,LOGIC1(109)),  MEL11600 

8    (CONRHO,LOGIC1(110)),(EMDOT,LOGIC1(111)),  MEL11610 

8    (0NEPHS,L0GICl(il2)),(INC0RS(l),L0GICH113))  MEL11620 

EQUIVAL ENCE( I  SAVED, LOGICK 123 )),(SAVEI, LOGICK 124)),  MEL  116  30 

8    (SAVEM,L0GIC1(125)), ( RESTRT , LOGIC1 ( 126 ) ) ,  MEL11640 

8    (XCYCLE,L0GIC1(127)),(M0NITR,L0GIC1(128)),  MEL11650 

8    (REGI0N(1),L0GIC1(129)), (STEADY, LOGICK 139 ) ) ,  MEL11660 

8    (WHOLEP,LOGIC1(140)), ( SLA3PP, LOGIC1 ( 141) ) ,  MEL11670 

8    (RAIN,L0GIC1(142)),(BL0CKZ,L0GIC1(143)),  MEL11680 

8    (PWSTAG,L0GIC1(144)),(RUN(1),L0GIC1(145)),  MEL11690 

8    (PLOT,  L0GICK175)),  (RESMAP,  LOGIC1  ( 176  )  ) ,  MEL11700 

8    ( FL AG, L OGIC1 ( 177 )),( BLOCK, LOGICK 178 )),( TEST, LOGICK 179))  MEL  117 10 

EQUIVALENCE(CONC1(1),LOGIC1(206))  MEL  11720 

EQUIVALENCE  ( SPRESS, LOGIC( 100 ) ) , (PARAB, LOGIC( 99) ) ,  MEL11730 

8    (D0NACC,L0GIC(98))  MEL11740 

EQUIVALENCE  ( OVERLY, LOGIC( 96 )),( SACC, LOGIC( 95) ) ,  MEL11750 

8    (WSTAG,L0GIC(94))  MEL11760 

EQUIVALENCE  ( DISTIL , LOGIC( 90  ) )  MEL11770 

EQUIVALENCE  ( PAMELA, L0GIC(67 )), (TOPSI , LOGIC(66 )) ,  MEL11780 

8    (TIBALT,L0GIC(65)),(TACT,L0GIC(64)),(HELGA,L0GIC(63)),  MEL  117 9  0 

8    ( SPLASH, L0GIC(62)),( PLANT, L0GIC(61 ) ) , (PICALO, LOGIC(60) ) ,  MEL  118 0  0 

8    (HESTER,  L0GIC(59)),(GENMIX,L0GIC(58)),(F0CS,L0GIC( 57)),  MEL  118 10 

8    ( FLORA, L OGIC( 56 )),( FLASH, LOGIC( 55 )),( ESTER, LOGIC( 54)),  MEL  11820 

8    (CORA, L 0GIC(53 ) ), (CONNIE, LOGIC( 52 )),( CATHY, LOGIC( 51)),  MEL  11830 

a    (GUSSIE, LOGIC(50))  MEL11840 

EQUIVALENCE  (TABLES, LOGIC( 48 )), (CONMOD, L0GIC(47 )) ,  MEL11850 

8    (GR0STA,L0GIC(46)),(SUBPST,L0GIC(45))  MEL11860 

EQUIVALENCE  ( SUBWGR, L0GIC(43) )  MEL11870 

INTEGER  FSTEP,FSWEEP,TSTSWP,ITAB(8),MTABVR(8)  MEL11880 

DIMENSION  ISPCS0(25),LITER(25)  MEL11890 

EQUIVALENCE  (NX, INTGR1 ( 1 ) ) , (NY, INTGR1 ( 2) ) ,  MEL11900 

8    (NZ,INTGR1(3)),(ISPCS0(1),INTGR1(4)),  MEL11910 

8    (NREGN,INTGR1(29)),(NPHI,INTGR1(30)),  MEL11920 

8    (LITKE,INTGR1(31)),(LITHYD,INTGR1(32)),  MEL11930 

8    (LITH,INTGR1(33)),(LITCNC,INTGR1(34)),  MEL11940 

8    (LITSLB,INTGR1(35)),(NRUN,INTGR1(36)),  MEL11950 

8    (LITER(1),INTGR1(37)),(FSTEP,INTGR1(62)),  MEL11960 

8    (FSWEEP,INTGR1(63)),(LSTEP,INTGR1(64))  MEL11970 

EQUIVALENCE  ( LSWEEP, INTGR1 (65) ) , ( NPRINT, INTGR1 (66 ) ) ,  MEL11980 

8    (IERRP,INTGR1(67)),(IMAXP,INTGR1(68)),  MEL11990 

8    (IEMU1,INTGR1(69)),(IXM0N,INTGR1(70)),  MEL12000 

8    (IYM0N,INTGR1(71)),(IZM0N,INTGR1(72)),  MEL12010 

8    (KEMU,INTGR1(73)),(KMAIN,INTGR1(74)),  MEL12020 

8    (KINDEX,INTGR1(75)),(KGE0M,INTGR1(76)),  MEL12030 

8    (KINPUT,INTGR1(77)),(KS0DAT,INTGR1(78))  MEL12040 
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EQUIVALENCE(KFLAG,INTGR1(79)),(KCOMPF,INTGR1(80)),  MEL  12050 

8  (KS0RCE,INTGR1(81)),(KLES1D,INTGR1(82)),  MEL12060 

S  CKLES2D,INTGR1C83)),CKLES3D,INTGR1C84)),  MEL12070 

8  CKC0MPP,INrGRlC85)),CKADJST,INTGRlC86)),  MEL12080 

8  (KFLUX,INTGR1(87)),(KSHIFT,INTGR1C88)),  MEL12090 

8  CK0UTPT,INTGR1C89)),CKDIF,INTGR1C90)),  MEL12100 

8  CKC0MPU,INTGR1C91)),CKC0MPV,INTGR1C92)),  MEL12110 

8  CKC0MPW,INTGR1C93)),CKC0MPR,INTGR1C94))  MEL12120 

EQUIVALENCE  ( KELIN, INTGRC 100 ) ) , (MEANDF, INTGRC 99) ) ,  MEL12130 

8  CNUMCLS,INTGRC98)),  MEL12140 

8  (IRH01,INTGR(97)),(IRH02,INTGR(96)),  MEL12150 

8  CIZH1,INTGRC95)),CIZW2,INTGRC94)),  MEL12160 

8  CMGRID,INTGRC93)),CKWALL,INTGRC92)),  MEL12170 

8  CIZPR1,INTGRC91)),CIZPR2,INTGRC90)),  MEL12180 

8  CISTPR1,INTGRC89)),CISTPR2,INTGRC88)),  MEL12190 

8  CNTPRIN,INTGRC87))  MEL12200 

EQUIVALENCE  ( IMDOT, INTGRC 86 )),( IHSAT , INTGRC85) ) ,  MEL12210 

8  C ICFIP, INTGRC 84)),CNTABLE, INTGRC 83) ), C NTABVR, INTGRC 82) ) ,  MEL  12220 

8  CLINTAB, INTGRC 81) ),CNPRTAB, INTGRC 80 )), C NMON , INTGRC 79 )) ,  MEL  12230 

8  CITABC1),INTGRC71)),CMTABVRC1),INTGRC63)),  MEL12240 

8  CNZPRIN,INTGRC62)),  MEL12250 

8  CNXPRIN,INTGRC61)),CNYPRIN,INTGRC60)),  MEL12260 

8  CLDISTL,INTGRC59)),CTSTSWP,INTGRC58)),  MEL12270 

8  CKDBEXP,INTGRC57)),CKDBRH0,INTGRC56)),  MEL12280 

8  CKDBMDT,INTGRC55))  MEL12290 

EQUIVALENCE  C IL00P1 , INTGRC 53) ), C ILOOPN, INTGRC 52) ) ,  MEL12300 

8  CIPBP,INTGRC51)),CIZPRF,INTGRC50)),  MEL12310 

8  CIZPRL,INTGRC49)),CISTPRF,INTGRC48)),  MEL12320 

8  CISTPRL,INTGRC47)),CKDBGEN,INTGRC<46)),  MEL12330 

8  (IVELF,INTGR(45)),(IVELL,INTGR(44)),  MEL12340 

8  CIKEF,INTGRC43)),CIKEL,INTGRC42)),  MEL12350 

8  CIENTF,INTGRC41)),  C IENTL , INTGRC 40 )) ,  MEL12360 

8  CICNCF,INTGRC39)), ( ICNCL , INTGRC 38 )) ,  MEL12370 

8  CNVEL,INTGRC37) ), C NKE, INTGRC 36 )) ,  MEL12380 

8  CNENT,INTGRC35)),CNCNC,INTGRC34)),  MEL12390 

8  CNZSTP,INTGRC33)),CNPRMNT,INTGRC32))  MEL12400 

DIMENSION  SPARE1C20),XUDISTC30),YVDISTC30),ZWDISTC50),  MEL12410 

8  SIGMAC25),CRITC25),DTFALSC25),RESREFC25),  MEL12420 

8  TITLEC25),FIINITC25),TFRACC30)  MEL12430 

EQUIVALENCE  C SPARE1 C 1 ) , RE1 C 1 ) ) ,  MEL12440 

8  (TFRACC1),RE1C21)),CXULAST,RE1C51)),  MEL12450 

8  CYVLAST,RE1C52)),CZWLAST,RE1C53)),  MEL12460 

8  CXUDISTC1),RE1C54)),CYVDISTC1),RE1C84)),  MEL12470 

8  CZWDISTC1),RE1C11<4)),CSIGMAC1),RE1C164)),  MEL12480 

8  CCRITC1),RE1C189)),CDTFALSC1),RE1C21<+)),  MEL12490 

8  CRESREFC1),RE1C239)),CEMU1,RE1C264)),  MEL12500 

8  CRH01,RE1C265)),CRH02,RE1C266)),  MEL12510 

8  CTLAST,RE1C267)),CCFIPS,RE1C268))  MEL12520 

EQUIVALENCE  C AMDOT, RE1 C 269) ) , C FIINITC 1 ) , RE1C270) ) ,  MEL12530 

8  CRELAXP,RE1C295)),CTITLE(1),RE1C296)),  MEL12540 

8  CDT,RE1C321)),  MEL12550 

8  CRINNER,ZWDISTC50)),CSNALFA,ZWDIST(49)),  MEL12560 

8  CPBAR,ZWDISTC48))  MEL12570 

EQUIVALENCE  C SLOEMU, REC 100) ) , CSLORHO, REC99 ) ) , (RLXRHO, REC98 ) ) ,  MEL  12580 

8  CRH0MAX,REC97)),CRH0MIN,REC96)),  MEL12590 

8  CEMUMAX,REC95)),CEMUMIN,REC94)),  MEL12600 

8  CTKEMAX,REC93)),CTKEMIN,REC92)),  MEL12610 

8  CRLXPZ,REC91)),  MEL12620 

8  CABU0Y,REC90)),CHREF,REC89)),  MEL12630 

8  CAGRAVX,REC88)),CAGRAVY,REC87)),  MEL12640 

8  CAGRAVZ,REC86)),CATIME,REC85))  MEL12650 

EQUIVALENCE  C RLXPXY, REC84) ) ,  MEL12660 

8  CEPSMAX,REC83)),CEPSMIN,REC82)),  MEL12670 

8  CARH01,REC81)),CBRH01,REC80)),CCRH01,RE(79))  MEL12680 

EQUIVALENCE  C AZW2, REC73) ) , C BZW2, REC74) ) ,  MEL12690 

8  CPINT,REC75)),CCZW2,REC76)),  MEL12700 

8  CDZ,REC78)),CZWL,REC77)),CZW2M1T,RE(72)),  MEL12710 

8  CVELMIN,REC70)),CVELMAX,REC69)),  MEL12720 

8  CFALC0M,REC68)),CCMD0T,REC67)),  MEL12730 

8  CRLXMDT,REC66)),CAMDTMX,REC65)),CAMDTMN,REC64)),  MEL12740 

8  CRADMAX,REC63)),CRADMIN,REC62)),  MEL12750 

8  (PRESS, RE(61)),(CP1,RE(60)),  MEL12760 
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8    (CP2,RE(59)),(CP3,RE(58)),(FST0IC,RE(57)), 

8    CARRC0N,RE(56)),(PREEXP,RE(55)),(CA1I,RE(54)) 

EQUIVALENCE  (CA2I , REC53) ) , (CA13, RE( 52) ) , CCA23, REC51 ) ) , 
8    (H1SAT,RE(50)),(H2SAT,RE(49)), 
8    (EMULAM,RE(48)) 
EQUIVALENCE  (TWPRCN,  RE(  42) ) ,  (  PSATEX,  RE(  41 )  ) 
EQUIVALENCE(ELEXP,RE(39)),(EWALL,RE(38)), 
8    (SIGE,RE(37)),(SIGK,RE(36)),(TAUDK,RE(35)) 

DIMENSION  L0CK6),L0C2(6),L0C3(6),L0C4(6),L0C5(6), 
&    LOC6(6),LOC7(6),LOC8(6),LOC9(6),LOC10(6) 
EQUIVALENCE  ( LOCREG( 1 ) , LOCK  1 ) ) , ( L0CREG(7 ) , L0C2C1 ) ) 

(L0CREG(13),L0C3(1)),(L0CREG(19),L0C4(1)) 
(L0CREG(25),L0C5(1)),(L0CREG(31),L0C6(1)) 
( LOCREGC  37 ) , L0C7 ( 1 ) ) , ( LOCREGC  43 ) , L0C8 ( 1 ) ) 
(LOCREG(49),LOC9(1)),(LOCREG(55),LOC10(1)) 


EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 
EQUIVALENCE 


DIMENSION  XUFRAC(30),YVFRAC(30) , ZWFRACC30) 

DIMENSION  XFRAC(30),YFRAC(30),ZFRAC(30) 

EQUIVALENCE(XUDIST(1),XUFRACU),XFRAC(1)), 

8  (YVDIST(1),YVFRAC(1),YFRAC(1)), 

8  (ZWDIST(1),ZWFRAC(1),ZFRAC(1)) 


ENDIK25) 


8 


(RLXP,RELAXP) 


(ENDIT(1),CRIT(1)) 
EQUIVALENCE  (NPRMON, LITERC 1 ) ) 

Q(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
SATLIT-EQUIVALENT  IRUN: 
EQUIVALENCE  ( IRUN, INTGRC 11) ) 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
USER  PLACES  HIS  VARIABLES,  ARRAYS, 
USER  PLACES  HIS  DATA  STATEMENTS  HERE. 

[XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER 

:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

GO   TO    (10,20,30,40,50,60),IGOTO 


(LITCNCLITC) 


STANDARD  SECTION  1  STARTS 


STANDARD  SECTION  1  ENDS. 
USER  SECTION  1  STARTS: 
EQUIVALENCES  ETC.  HERE. 

SECTION  1  ENDS. 
STANDARD  SECTION  2  STARTS 


:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 
:xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 


STANDARD  SECTION  2  ENDS 
USER  SECTION  2  STARTS: 


SECTION  1:  SET  FORWARD  STEP  SIZE  DZ  FOR  IZSTEP>1  WHEN 

ZWLAST  <  0.  IN  DATA. 

AT  IZSTEP=1  EARTH  SETS  DZ  =  ABS(ZWDIST( 1 )*ZWLAST) 


10  CONTINUE 
***USER  SETS  DZ  HERE. 
RETURN 


SECTION  2:  SET  X-WIDTH  (XULAST)  OF  GRID  FOR  IZSTEP  >  1 

WHEN  XULAST  <  0.  IN  DATA. 

AT  IZSTEP=1  EARTH  SETS  XULAST  =  ABS(XULAST) 


20  CONTINUE 

EXXXUSER  SETS  XULAST  HERE 
RETURN 


SECTION  3:  SET  Y-WIDTH  (YVLAST)  OF  GRID  FOR  IZSTEP  >  1 

WHEN  YVLAST  <  0  IN  DATA. 

AT  IZSTEP=1  EARTH  SETS  YVLAST  =  ABS(YVLAST) 


30  CONTINUE 

ixxxUSER  SETS  YVLAST  HERE 
RETURN 


SECTION  4:    SET  INNER  RADIUS  (RINNER)  OF  GRID  FOR  IZSTEP  >  1 

WHEN  RINNER  <  0  IN  DATA. 

AT  IZSTEP=1  EARTH  SETS  RINNER  =  ABS(RINNER) 


40  CONTINUE 

EXXXUSER  SETS  RINNER  HERE.. 
RETURN 


SECTION  5:  SET  SLOPE  (SNALFA)  OF  INNER  EDGE  OF  GRID  FOR 
IZSTEP  >  1   WHEN  SNALFA>  1,  8  CARTES  =  .FALSE. 
AT  IZSTEP=1  EARTH  SETS  SNALFA  =  SNALFA-2. 


50  CONTINUE 


MEL12770 
MEL12780 
MEL12790 
MEL12800 
MEL12810 
MEL12820 
MEL12830 
MEL12840 
MEL12850 
MEL12860 
MEL12870 
MEL12880 
MEL12890 
MEL12900 
MEL12910 
MEL12920 
MEL12930 
MEL12940 
MEL12950 
MEL12960 
MEL12970 
MEL12980 
MEL12990 
MEL13000 
MEL13010 
MEL13020 
MEL13030 
MEL13040 
MEL13050 
MEL13060 
MEL13070 
MEL13080 
MEL13090 
MEL13100 
MEL13110 
MEL13120 
MEL13130 
MEL13140 
MEL13150 
MEL13160 
MEL13170 
MEL13180 
MEL13190 
MEL13200 
MEL13210 
MEL13220 
MEL13230 
MEL13240 
MEL13250 
MEL13260 
MEL13270 
MEL13280 
MEL13290 
MEL13300 
MEL13310 
MEL13320 
MEL13330 
MEL13340 
MEL13350 
MEL13360 
MEL13370 
MEL13380 
MEL13390 
MEL13400 
MEL13410 
MEL13420 
MEL13430 
MEL13440 
MEL13450 
MEL13460 
MEL13470 
MEL13480 
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CXXXXXUSER  SETS  SNALFA  HERE...  MEL13490 

RETURN  MEL13500 

c MEL  13510 

C     SECTION  6:  SET  MEAN  PRESSURE  (PBAR)  AT  NEXT  FORWARD  STEP  MEL13520 

C     WHEN  PBAR  <  0.  IN  DATA.  MEL13530 

C     FOR  UNCONFINED  FLOWS  WITH  IMPRESSED  NON-ZERO  MEL13540 

C     PRESSURE  GRADIENTS  SET  PBAR  HERE;  FOR  CONFINED  MEL13550 

C     FLOWS  EARTH  AUTOMATICALLY  COMPUTES  PRESSURE  REQUIRED.  MEL13560 

c MEL  1357  0 

60  CONTINUE  MEL13580 

CXXXXXUSER  SETS  PBAR  HERE...  MEL13590 

RETURN  MEL13600 

END  MEL13610 
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[RECTIVEXXSATLIT  MELOOOIO 

XFILE  NAME:  MODSTL.FTN  MEL00020 

^ABSTRACT:  SATELLITE  MODEL  MAIN  PROGRAM.  MEL00030 

^DOCUMENTATION:  PHOENICS  INSTRUCTION  MANUAL  (SPRING  1983).  MEL00040 

^AUXILIARY  SUBROUTINES  (TAPES,  ETC.)  ARE  IN  SATELLITE  LIBRARY  MEL00050 

SERVICEU,  WHICH  MUST  BE  INCLUDED  IN  LINK  EDIT  TO  RUN.  MEL00060 

<XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  1  STARTS:  MEL  00070 

MEL  00 08  0 

3TER  1    COMMON  BLOCKS  AND  USER'S  DATA.  MEL00090 
MEL  001 0  0 

^CLUDE  9,CMNGUSSI.FTN/G  MEL00110 

LOGICAL  LOGIC1, LOGIC  MEL00120 

DIMENSION  LOGIC(IOO)  MEL00130 

COMMON/ L DATA/ LOGICK 309)  MEL  001 4  0 

EQUIVALENCE  ( LOGIC( 1 ) , LOGIC1 ( 210 ) )  MEL00150 

DIMENSION  INTGR(IOO)  MEL00160 

COMMON/ 1  DATA/ 1 NTGRK 194)  MEL  0  0 17  0 

EQUIVALENCE  ( INTGRC 1 ) , INTGR1 ( 95) )  MEL00130 

DIMENSION  RE(IOO)  MEL00190 

C0MM0N/RDATA/REK421)  MEL00200 

EQUIVALENCE  ( RE( 1 ) , REK 322) )  MEL00210 

COMMON/ BOUND/ LOCREG(60),  MEL  0  0220 

STR1,CP1RK7),VP1RK7),CP2RK5),VP2RK5),CPNRK5),VPNRK5),  MEL  00230 

8TR2,CP1R2(7),VP1R2(7),CP2R2(5),VP2R2(5),CPNR2(5),VPNR2(5),  MEL  0  0  240 

STR3,CP1R3(7),VP1R3(7),CP2R3(5),VP2R3(5),CPNR3(5),VPNR3(5),  MEL  0  0  250 

8TR4,CP1R4(7),VP1R4(7),CP2R4(5),VP2R4(5),CPNR4(5),VPNR4(5),  MEL  0026  0 

8TR5,CP1R5(7),VP1R5(7),CP2R5(5),VP2R5(5),CPNR5(5),VPNR5(5),  MEL  0  027  0 

8TR6,CP1R6C7),VP1R6C7),CP2R6(5),VP2R6(5),CPNR6(5),VPNR6(5),  MEL  0  0280 

8TR7,CP1R7(7),VP1R7(7),CP2R7(5),VP2R7(5),CPNR7(5),VPNR7(5),  MEL  0029  0 

8TR8,CP1R8(7),VP1R3(7),CP2R8(5),VP2R3(5),CPNR8(5),VPNR8(5),  MEL  00 30  0 

8TR9,CP1R9(7),VP1R9(7),CP2R9(5),\/P2R9(5),CPNR9(5),VPNR9(5),  MEL  00310 

8TR10,CP1R10(7),VP1R10(7),CP2R10(5),VP2R10(5),CPNR10(5),VPNR10(5)   MEL  0  0 320 

DIMENSION  TCVREG(350)  MEL00330 

EQUIVALENCE  CTCVREGC 1 ) , TR1 )  MEL00340 

JCLUDE    9,GUSSEQUI . FTN/G  MEL00350 

LOGICAL  CARTES, POLAR, SPDATA, SKEW, TWODYZ, ONEDZ, STOVAR( 25),  MEL  0  036  0 

8    S0LVAR(25),PRINT(25),RESID(25),CMPRSS,C0NEMU,LSP1,  MEL00370 

8    CONRHO,EMDOT,ONEPHS,INCORE(10),ISAVED,SAVEI,SAVEM,  MEL00380 

8    RESTRT,XCYCLE,MONITR,REGION( 10), STEADY, WHOLEP, SLABPP,  MEL  00390 

8    RAIN, BL0CKZ,PWSTAG,RUN(30), PLOT, RESMAP, FLAG, BLOCK,  MEL00400 

8    TEST,  C0NCK4),  DISTIL  MEL00410 

LOGICAL  SPRESS,PARAB,DONACC, OVERLY, SACC,  MEL00420 

8    GUSSIE, CATHY, CONNIE, CORA, ESTER, FLASH, FLORA,  MEL00430 

8    FOCS,GENMIX, HESTER, PICALO, PLANT, SPLASH, HELGA,  MEL00440 

8    TACT, TIBALT,TOPSI, PAMELA, TABLES, WSTAG,  MEL00450 

8    CONMOD,GROSTA,SUBPST,SUBWGR  MEL00460 

EQUIVALENCE  (CARTES, LOGIC1 ( 1 )), (POLAR, LOGIC1 ( 2) ) ,  MEL00470 

8    (  SPDATA,  LOGICK  3)),  (SKEW,  LOGICK  4)),  (TWODYZ,  L0GICK5)),  MEL  00480 

8    (ONEDZ, L0GICK6)),(ST0VAR(1),L0GICK7)),  MEL00490 

8    (S0LVAR(1),L0GICK32)),(PRINT(1),L0GICK57)),  MEL00500 

8    (RESID(1),LOGICK82)),(CMPRSS,LOGICK107)),  MEL00510 

8    (CONEMU,LOGICK108)),(LSP1,LOGICK109)),  MEL00520 

8    (CONRHO,LOGICK110)),(EMDOT,LOGICK111)),  MEL00530 

8    (0NEPHS,L0GICK112)),(INC0RE(1),L0GICK113))  MEL00540 

EQUIVALENCEdSAVED,  LOGICK  123  )),(SAVEI,  LOGICK  124)),  MEL  00550 

8    (SAVEM,L0GICK125)),(RESTRT,L0GICK126)),  MEL00560 

8    (XCYCLE,L0GICK127)),(M0NITR,L0GICK128)),  MEL00570 

8    (REGI0N(1),L0GICK129)), (STEADY, LOGIC! ( 139 )) ,  MEL00580 

8    (WHOLEP, LOGICK140)), (SLABPP, L0GICK14D),  MEL00590 

8    (RAIN,L0GICK142)),(BL0CKZ,L0GICK143)),  MEL00600 

8    (PWSTAG,L0GICK144)),(RUN(1),L0GICK145)),  MEL00610 

8    (PLOT, L0GICK175)), (RESMAP, L0GICK176)),  MEL00620 

8    (FLAG, LOGICK 177)), (BLOCK, LOGICK 178)), (TEST, LOGICK 179))  MEL  006 30 

EQUIVALENCE(CONCKl),  LOGICK  206))  MEL  00640 

EQUIVALENCE  ( SPRESS, LOGIC( 100 ) ) , (PARAB, LOGIC( 99) ) ,  MEL00650 

8    (D0NACC,L0GIC(98))  MEL00660 

EQUIVALENCE  (OVERLY, LOGIC(96 )), (SACC, LOGIC( 95) ) ,  MEL00670 

8    (WSTAG, L0GIC(94))  MEL00680 

EQUIVALENCE  ( DISTIL , LOGIC( 90) )  MEL00690 

EQUIVALENCE  ( PAMELA, LOGIC(67 )), (TOPSI , L0GIC(66 )) ,  MEL00700 

8    (TIBALT,LOGIC( 6  5 )),( TACT, LOGIC( 64 )),( HELGA, L0GIC(63)),  MEL  007 10 

8    ( SPLASH, L0GIC(62)),( PLANT, LOGIC(6D), (PICALO, LOGIC(60)),  MEL  007 20 
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S    (HESTER,L0GIC(59)),(GENMIX,L0GIC(58)),(F0CS,L0GIC(57)),  MEL  007 30 

8    (FL0RA,L0GIC(56)),(FLASH,L0GIC(55)),(ESTER,L0GIC(54)),  MEL  00740 

8    (C0RA,L0GIC(53)),(C0NNIE,L0GIC(52)),(CATHY,L0GIC(51)),  MEL  0  0750 

8    (GUSSIE,LOGIC(50))  MEL00760 

EQUIVALENCE  (TABLES,  LOGIC(  48  )),  (CONMOD,  LOGICC  47  ))  ,  MEL00770 

8    (GR0STA,L0GIC(46)),(SUBPST,L0GIC(45))  MEL00780 

EQUIVALENCE  ( SUBWGR, LOGICC 43) )  MEL00790 

INTEGER  FSTEP,FSWEEP,TSTSWP,ITAB(8),MTABVR(8)  MEL00800 

DIMENSION  ISPCS0(25),LITER(25)  MEL00810 

EQUIVALENCE  ( NX, INTGR1 ( 1 ) ) , ( NY, INTGR1 (2) ) ,  MEL00820 

8    (NZ,INTGR1(3)), ( ISPCSO( 1 ) , INTGR1 ( 4) ) ,  MEL00830 

8    (NREGN,INTGR1(29)),(NPHI,INTGR1(30)),  MEL00840 

8    (LITKE,INTGR1(31)),(LITHYD,INTGR1(32)),  MEL00850 

8    (LITH,INTGR1(33)),(LITCNC,INTGR1(34)),  MEL00860 

8    (LITSLB,INTGR1(35)),(NRUN,INTGR1(36)),  MEL00870 

8    (LITER(1),INTGR1(37)),(FSTEP,INTGR1(62)),  MEL00880 

8    (FSWEEP,INTGR1(63)),(LST£P,INTGR1(64))  MEL00890 

EQUIVALENCE  ( LSWEEP, INTGR1 (65 ) ) , ( NPRINT, INTGR1 (66 ) ) ,  MEL00900 

8    (IERRP,INTGR1(67)),(IMAXP,INTGR1(68)),  MEL00910 

8    (IEMU1,INTGR1(69)),(IXM0N,INTGR1(70)),  MEL00920 

8    (IYM0N,INTGR1(71)),(IZM0N,INTGR1(72)),  MEL00930 

8    (KEMU,INTGR1(73)),(KMAIN,INTGR1(74)),  MEL00940 

8    (KINDEX,INTGR1(75)),(KGE0M,INTGR1(76)),  MEL00950 

8    (KINPUT,INTGR1(77)),(KS0DAT,INTGR1(78))  MEL00960 

EQUIVALENCE(KFLAG,INTGR1(79)),(KCOMPF,INTGR1(80)),  MEL  0  097  0 

8    (KS0RCE,INTGR1(81)),(KLES1D,INTGR1(82)),  MEL00980 

8    (KLES2D,INTGR1(83)),(KLES3D,INTGR1(84)),  MEL00990 

8    (KC0MPP,INTGR1(85)),(KADJST,INTGR1(86)),  MEL01000 

8    (KFLUX,INTGR1(87)), ( KSHIFT, INTGR1 (83 ) ) ,  MEL01010 

8    (K0UTPT,INTGR1(89)),(KDIF,INTGR1(90)),  MEL01020 

a    (KC0MPU,INTGR1(91)),(KC0MPV,INTGR1(92)),  MEL01030 

8    (KC0MPW,INTGR1(93)),(KC0MPR,INTGR1(94))  MEL01040 

EQUIVALENCE  ( KELIN , INTGR( 100 ) ) , (MEANDF, INTGR( 99 ) ) ,  MEL01050 

8    (NUMCLS,INTGR(98)),  MEL01060 

8    (IRH01,INTGR(97)),(IRH02,INTGR(96)),  MEL01070 

8    (IZW1,INTGR(95)),(IZW2,INTGR(94)),  MEL01080 

S    (MGRID,INTGR(93)),(KWALL,INTGR(92)),  MEL01090 

8    (IZPR1,INTGR(91)),(IZPR2,INTGR(90)),  MEL01100 

8    (ISTPR1,INTGR(89)),(ISTPR2,INTGR(88)),  MEL01110 

8    (NTPRIN,INTGR(87))  MEL01120 

EQUIVALENCE  ( IMDOT, INTGR(86 ) ) , ( IHSAT, INTGR(85) ) ,  MEL01130 

8    (ICFIP,INTGR(84)),(NTABLE,INTGR(83)),(NTABVR,INTGR(82)),  MEL  01 140 

8    (LINTAB,INTGR(81)),(NPRTAB,INTGR(80)),(NM0N,INTGR(79)),  MEL  01 150 

8    (ITAB(1),INTGR(71)),(MTABVR(1),INTGR(63)),  MEL01160 

8    (NZPRIN,INTGR(62)),  MEL01170 

8    (NXPRIN,INTGR(61)),(NYPRIN,INTGR(60)),  MEL01180 

8    (LDISTL,INTGR(59)),(TSTSWP,INTGR(58)),  MEL01190 

8    (KDBEXP,INTGR(57)),(KDBRH0,INTGR(56)),  MEL01200 

8    (KDBMDT,INTGR(55))  MEL01210 

EQUIVALENCE  ( ILOOP1 , INTGR(53) ) , ( ILOOPN, INTGR(52) ) ,  MEL01220 

8    (IPBP,INTGR(51)),(IZPRF,INTGR(50)),  MEL01230 

8    (IZPRL,INTGR(49)),(ISTPRF,INTGR(48)),  MEL01240 

8    (ISTPRL,INTGR(47)),(KDBGEN,INTGR(46)),  MEL01250 

8    (IVELF,INTGR(45)),(IVELL,INTGR(44)),  MEL01260 

8    (IKEF,INTGR(43)),(IKEL,INTGR(42)),  MEL01270 

8    (IENTF,INTGR(41)),(IENTL,INTGR(40)),  MEL01280 

8    (ICNCF,INTGR(39)),(ICNCL,INTGR(38)),  MEL01290 

8    (NVEL,INTGR(37)),(NKE,INTGR(36)),  MEL01300 

8    (NENT,INTGR(35)),(NCNC,INTGR(34)),  MEL01310 

8    (NZSTP,INTGR(33)),(NPRMNT,INTGR(32))  MEL01320 

DIMENSION  SPARE1(20),XUDIST(30),YVDIST(30),ZWDIST(50),  MEL01330 

8    SIGMA(25),CRIT(25),DTFALS(25),RESREF(25),  MEL01340 

8    TITLE(25),FIINIT(25),TFRAC(30)  MEL01350 

EQUIVALENCE  (SPAREK 1) , RE1 ( 1 ) ) ,  MEL01360 

8    (TFRAC(1),RE1(21)),(XULAST,RE1(51)),  MEL01370 

8    (YVLAST,RE1(52)),(ZWLAST,RE1(53)),  MEL01380 

8    (XUDIST(1),RE1(54)),(YVDIST(1),RE1(84)),  MEL01390 

8    (ZWDIST(1),RE1(114)),(SIGMA(1),RE1(164)),  MEL01400 

8    (CRIT(1),RE1(189)),(DTFALS(1),RE1(214)),  MEL01410 

8    (RESREF(1),RE1(239)),(EMU1,RE1(264)),  MEL01420 

8    (RH01,RE1(265)),(RH02,RE1(266)),  MEL01430 

8    (TLAST,RE1(267)),(CFIPS,RE1(268))  MEL01440 
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EQUIVALENCE  C AMDOT, RE1 ( 269 ) ) , ( FIINITC 1 ) , RE1 ( 270) ) ,  MEL01450 

8    CRELAXP,RE1C295)),(TITLEC1),RE1C296)),  MEL01460 

8    CDT,RE1C321)),  MEL01470 

5  (RINNER,ZWDISTC50)),CSNALFA,ZWDISTC49)),  MEL01480 
8    CPBAR,ZWDISTC48))  MEL01490 

EQUIVALENCE  ( SLOEMU, RE( 1 0  0 ) ) , ( SLORHO, RE( 99 ) ) , CRLXRHO, RE( 98 ) ) ,  MEL  01500 

6  (RHOMAX,REC97)), C RHOMIN, REC 96 ) ) ,  MEL01510 
8  CEMUMAX,REC95)),CEMUMIN,REC94)),  MEL01520 
8  CTKEMAX,REC93)),CTKEMIN,REC92)),  MEL01530 
8  CRLXPZ,REC91)),  MEL01540 
8  (ABUOY,REC90)),CHREF,REC89)),  MEL01550 
&  CAGRAVX,REC88)),CAGRAVY,REC87)),  MEL01560 
&    (AGRAVZ,REC86)), C ATIME, REC85) )  MEL01570 

EQUIVALENCE  ( RLXPXY, RE( 84) ) ,  MEL01580 

8    CEPSMAX,REC83)),CEPSMIN,RE(82)),  MEL01590 

8    (ARH01,REC81)), CBRH01,REC30)),(CRH01,REC79))  MEL01600 

EQUIVALENCE  C AZW2, REC73) ) , C BZW2, REC74 ) )  ,  MEL01610 

&    CPINT,RE(75)),(CZW2,REC76>),  MEL01620 

8    CDZ,RE(73)),(ZWL,REC77)), (ZW2M1T,REC72)),  MEL01630 

8    CVELMIN,REC70)),CVELMAX,REC69)),  MEL01640 

8    CFALC0M,RE(63)), CCMDOT, REC 67 ) ) ,  MEL01650 

8    CRLXMDT,REC66)),CAMDTMX,REC65)),CAMDTMN,REC64)),  MEL01660 

8    CRADMAX,REC63)),CRADMIN,REC62)),  MEL01670 

8    (PRESS, REC61)),CCP1,REC60)),  MEL01680 

8    (CP2,RE(59)),(CP3,RE(58)),(FSTOIC,RE(57)),  MEL01690 

8    (ARRC0N,RE(56)),CPREEXP,REC55)),CCA1I,REC54))  MEL01700 

EQUIVALENCE  (CA2I , RE( 53) ) , (CA13, RE( 52) ) , ( CA23, RE( 51 ) ) ,  MEL01710 

8    (H1SAT,RE(50)),CH2SAT,RE(49)),  MEL01720 

8    (EMULAM,RE(48))  MEL01730 

EQUIVALENCE  (TWPRCN, REC 42 ) ) , C PSATEX, RE(  41 ) )  MEL01740 

EQUIVALENCE(ELEXP,REC39)),CEWALL,REC38)),  MEL  01750 

8    (SIGE,RE(37)),CSIGK,REC36)), (TAUDK , RE( 35 ) )  MEL01760 

DIMENSION  L0C1C6),LCC2C6),L0C3(6),L0C4(6),L0C5C6),  MEL01770 

8    LOC6C6),LOC7(6),LOC3C6),LOC9(6),LOC10C6)  MEL01780 

EQUIVALENCE  C LOCREGC 1 ) , LOCI ( 1 ) ) , ( L0CREGC7 ) , L0C2C 1 ) )  MEL01790 

EQUIVALENCE  ( LOCREGC 13) , L0C3C 1 ) ) , ( LOCREGC 19 ) , L0C4C 1 ) )  MEL01800 

EQUIVALENCE  ( LOCREGC 25) , L0C5( 1 ) ) , ( LOCREG( 31 ) , LOC6 ( 1 ) )  MEL01810 

EQUIVALENCE  ( LOCREGC 37 ), L0C7 ( 1 )),( L0CREG( 43) , L0C8( 1 ) )  MEL01820 

EQUIVALENCE  ( LOCREGC 49 ), L0C9C 1 )),( LOCREGC 55) , LOC10C 1 ) )  MEL01830 

DIMENSION  XUFRAC(30),YVFRAC(30),ZWFRAC(30),ENDIT(25)  MEL01840 

DIMENSION  XFRAC(30),YFRAC(30),ZFRAC(30)  MEL01850 

EQUIVALENCE(XUDIST(1),XUFRAC(1),XFRAC(1)),  MEL  0186  0 

8  (YVDISTC1),YVFRACC1),YFRACC1)),  MEL01870 

8  (ZWDIST(1),ZWFRAC(1),ZFRAC(1)),(LITCNC,LITC),  MEL01880 

8  CENDITC1),CRIT(1)),CRLXP,RELAXP)  MEL01890 

EQUIVALENCE  C NPRMON, LITERC 1 ) )  MEL01900 

CLUDE  9,CMNGRFIC.FTN/G  MEL01910 

LOGICAL   GRAPHS,  ORTHOG,  ANTSYM  MEL01920 

COMMON  /  GRAF3  /  GRAPHS,  ORTHOG,  ANTSYM,  NPRT  MEL01930 

REAL  NAME  MEL01940 

COMMON  /  GRAF4  /  NAME  C25),ITITL  (5)  MEL01950 

C0MM0N/CPI/IPWRIT,IDUMC243)  MEL  01 96  0 

DIMENSION  GDTAPEC3),DFAULTC4)  MEL01970 

DIMENSION  ARRAY1C309),ARRAY2C194),ARRAY3(421)  MEL01980 

LOGICAL  ARRAY1,LSPDA,WRT,RD,NAMLST  MEL01990 

INTEGER  ARRAY2,XPLANE,YPLANE,ZPLANE  MEL02000 

INTEGER  P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS,EP,H1,H2,H3,C1,C2,  MEL 020 10 

8C3,C4  MEL02020 

REAL  NORTH, LOW  MEL02030 

EQUIVALENCE  C ARRAY1 C 1 ), CARTES) , CARRAY2C 1 ), NX)  MEL02040 

EQUIVALENCE  C ARRAY3C 1 ) , SPARE1 C 1 ) ) , CM1 , Rl ) , CM2, R2)  MEL02050 

EQUIVALENCE  C LSTRUN, INTGRC 12) ) , C NAMLST, L0GICC88 ) )  MEL02060 

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  1  ENDS.  MEL02070 

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  1  STARTS:  MEL02080 

GRAFFIC  ARRAYS  DIMENSIONED  AS  NEEDED...  MEL02090 

COMMON/GRAF1/PHI1C1)  /GRAF2/PHI2C 1 )  MEL02100 

POROSITY  8  SPECIAL  DATA  ARRAYS  DIMENSIONED  AS  NEEDED...  MEL02110 

DIMENSION  PEC1,1,1),PNC1,1,1),PH(1,1,1),PCC1,1,1)  MEL02120 

DIMENSION  LSPDAC1),ISPDAC1),RSPDAC1)  MEL02130 

USER  PLACES  HIS  VARIABLES,  ARRAYS,  EQUIVALENCES  ETC.  HERE.  MEL0214O 

DATA  TITEM0/4HTEM0/  MEL02150 

DATA  TITEMP/4HTEMP/  MEL02160 
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DATA  TITDEN/4HRH01/ 

DATA  NLSP,NISP,NRSP/1,1,1/ 
C     USER  PLACES  HIS  DATA  STATEMENTS  HERE. 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  1  ENDS. 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  2  STARTS: 
c 

CHAPTER  2    SET  CONSTANTS,  AND  ARRANGE  FILE  MANIPULATIONS. 

c 

C     PLEASE  DO  NOT  ALTER,  OR  RE-SET,  ANY  OF  THE  REMAINING 
C      STATEMENTS  OF  THIS  CHAPTER. 

DATA  CELL, EAST, WEST, NORTH, SOUTH, HIGH, LOW, VOLUME/ 
S  0. ,1. ,2. ,3. ,4. ,5. ,6. ,7.  / 

DATA  P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS,KE,EP,H1,H2,H3,C1,C2, 
&C3,C4/ 1,2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20/ 

DATA  FIXFLU,FIXVAL,0NLYMS,WALL/1.E- 10,1. El 0,0. 0,-1 0.0/ 

DATA  IPLANE,XPLANE,YPLANE,ZPLANE/0,1,2,3/ 

DATA  WRT,RD,DFAULT/.TRUE. , . FALSE ., 4HDEFA, 4HULT ., 4HDTA/ , 1HG/ 

DATA  GDTAPE/4HGUSI,4HE1.D,2HTA/ 

DATA  NLDATA,NIDATA,NRDATA/309,194,421/ 

DATA  NLCREG.NTCVRG/60,350/ 
CD    CALL  SETGRF 

CALL  TAPES(10,GDTAPE,3,1,4*NRDATA) 
c READ  DEFAULT  FILE  IF  BLOCKDATA  ABSENT 

IF(INTGR1(29) .NE.10)  GO  TO  2 
CALL  WRIT40(40HDATA  ESTABLISHED  IN  BLOCK  DATA.  ) 

GO  TO  3 

2  CALL  DEFLT 

CD   2  CALL  TAPES(1,DFAULT,4,2,4*NRDATA) 
CD    CALL  DATAIO(RD,l) 

CALL  WRIT40(40HDATA  TAKEN  FROM  DEFAULT. DTA  ON  GROUP  A/C) 

3  CALL  WRIT40(40HFILE  MODSTL . FTN  IS  THE  SATLIT  USED.      ) 

c 

CHAPTER  3    DEFINE  DATA  FOR  NRUN  RUNS. 

c 

CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  2  ENDS. 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  2  STARTS: 
C—   GROUP   41  MULTI-RUNS  :  RUNC  1-30  )<  .  T  .  ,  29*  .  F  .  > 
C 

DO  410  11=1,1 
410  RUN(II)=.TRUE. 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  2  ENDS. 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  3  STARTS: 
DO  10  IRUN=1,30 

IF( .NOT.RUN(IRUN))  GO  TO  10 
NRUN=NRUN+1 
LSTRUN=IRUN 
10  CONTINUE 

DO  999  IRUN=1,LSTRUN 

IF( .NOT.RUN(IRUN))  GO  TO  999 
INTGR(ll)  =  IRUN 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  3  ENDS. 
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  3  STARTS: 

C ALL  INTEGER  VARIABLES  ARE  DEFAULTED  TO  0,  AND  REAL  VARIABLES 

C     TO  0.0,  UNLESS  OTHERWISE  INDICATED. 

C     E.G.  BY  VARIABLE<10>,  OR  <10.0>  AS  APPROPRIATE. 

C     THE  DEFAULT  SETTINGS  OF  ALL  LOGICAL  VARIABLES  ARE  ALWAYS 

C     INDICATED,  E.G.  VARIABLE< . T . >,  OR   VARIABLE< . F . > . 

C 

C—   RUN1 

c 

C GROUP  1.  FLOW  TYPE  : 

C     PARAB<.F.>,CARTES<.T.>,ONEPHS<.T.> 

ONEPHS=. FALSE. 
c 

C—  GROUP  2.  TRANSIENCE  : 

C  STEADY<.T.>,ATIME,LSTEP<1>,FSTEP<1> 

C  TLAST<1.E10>,TFRAC(1-30)<30*1.> 

STEADY=. FALSE. 

C  LSTEP=30 

C  ATIME=0. 

C  TLAST=50E-4 

C  SERVICE  SUBROUTINE  FOR  'NT'  POWER-LAW  TIME  STEPS: 


MEL02170 
MEL02180 
MEL02190 
MEL02200 
MEL02210 
MEL02220 
MEL02230 
MEL02240 
MEL02250 
MEL02260 
MEL02270 
MEL02280 
MEL02290 
MEL02300 
MEL02310 
MEL02320 
MEL02330 
MEL02340 
MEL02350 
MEL02360 
MEL02370 
MEL02380 
MEL02390 
MEL02400 
MEL02410 
MEL02420 
MEL02430 
MEL02440 
MEL02450 
MEL02460 
MEL02470 
MEL02430 
MEL02490 
MEL02500 
MEL02510 
MEL02520 
MEL02530 
MEL02540 
MEL02550 
MEL02560 
MEL02570 
MEL02580 
MEL02590 
MEL02600 
MEL02610 
MEL02620 
MEL02630 
MEL02640 
MEL02650 
MEL02660 
MEL02670 
MEL02680 
MEL02690 
MEL02700 
MEL02710 
MEL02720 
MEL02730 
MEL02740 
MEL02750 
MEL02760 
MEL02770 
MEL02780 
MEL02790 
MEL02800 
MEL02810 
MEL02820 
MEL02830 
MEL02840 
MEL02850 
MEL02860 
MEL02870 
MEL02880 
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CALL  GRDPWR(0,30,50E-4,1. )  MEL02890 
MEL02900 

-  GROUP  3.  X-DIRECTION  :  MEL02910 
NX<l>,XULAST<1.0>,XFRAC(l-30)  MEL  02920 
SERVICE  SUBROUTINE  FOR  POWER-LAW  GRID:  MEL02930 
CALL  GRDPWRU,NX,XULAST,1.)  MEL02940 

MEL02950 

-  GROUP  4.  Y-DIRECTION  :  MEL02960 
NY<1>,YVLAST<1.0>,YFRAC(1-30),RINNER,SNALFA  MEL  0297  0 
SERVICE  SUBROUTINE  FOR  POWER-LAW  GRID:  MEL02980 
NY=100  MEL02990 
CALL  GRDPWR(2,100,4.E-3,1.    )  MEL03000 

MEL03010 

-  GROUP  5.  Z-DIRECTION  :  MEL03020 
NZ<l>,ZWLAST<1.0>,ZFRAC(l-30)  MEL  030  30 
SERVICE  SUBROUTINE  FOR  POWER-LAW  GRID:  MEL03040 
CALL  GRDPWR(3,NZ,ZWLAST, POWER)  MEL03050 

MEL03060 

-  GROUP  6.  MOVING  GRID  :  MEL03070 

MGRID,IZW1,IZW2,AZW2,BZW2,CZW2,PINT,ZW2M1T  MEL  0303  0 
MEL03090 

-  GROUP  7 .  BLOCKAGE:  BLOCK< . F . >, IPLANE, IPWRIT  MEL03100 
*SET  CONSTANT  POROSITIES  OVER  SUB-DOMAINS  USING:  MEL03110 

CALL  CONPORCIR, TYPE, VALUE, IXF,IXL,IYF,IYL,IZF,IZL),  WHERE:  MEL03120 

IR=RUN  SECTION  NUMBER,  E.G.  1  FOR  RUN1  SECTION;  'TYPE'=  EAST,  MEL03130 

WEST,  NORTH,  SOUTH,  HIGH,  LOW  &  CELL.  'VALUE' =WANTED  POROSITY  MEL03140 

OVER  REGION  IXF,...IZL.  MEL03150 

^DIMENSION  ARRAYS  PEC  NX, NY, NZ) ,  PNC  NX, NY, NZ) ,  PHC NX, NY, NZ) ,  &  MEL03160 

PCCNX,NY,NZ)  ABOVE.  MEL03170 

XFOR  FULLY-BLOCKED  CELLS  CIE.  'VALUE'=  0.0)  USER  NEED  SET  ONLY  MEL03180 

THE  'CELL'  POROSITY  CTO  ZERO),  AS  CELL-FACE  AREAS  ARE  THEN  MEL03190 

AUTOMATICALLY  ZEROED.  MEL03200 

XFOR  SATELLITE  PRINTOUT  OF  ALL  POROSITIES  IN  DOMAIN,  «IPLANE'=  MEL03210 

XPLANE  YPLANE  OR  ZPLANE,  FOR  DESIRED  CROSS-SECTION  DIRECTION.  MEL03220 

*FOR  EACH  'TYPE'  A  MAXIMUM  OF  10  CALLS  TO  CONPOR  IS  ALLOWED,  MEL03230 

BUT  IF  REQUIREMENTS  EXCEED  THIS  PROVISION  SET  BLOCK=.T.  5.  MEL03240 

IPWRIT=-1,  AND  SET  POROSITY  ARRAYS  EXPLICITLY  HERE  AS  WANTED.  MEL03250 

IN  THIS  CASE,  THE  USER   MUST    SET   A  L  L   ELEMENTS  OF  MEL03260 

ARRAYS  PE,  PN,  PH,  PC  (MANY  MAY  BE  0.0  OR  1.0).  HE  MAY  USE:  MEL03270 

CALL  CR(PARRAY,VALUE,IXF,IXL,IYF,IYL,IZF,IZL,NX,NY,NZ)  MEL03280 

ANY  NUMBER  OF  TIMES,  TO  SET  'PARRAY'  (=  PE,  ETC.)  TO  MEL03290 

'VALUE'  OVER  RANGE  IXF  TO  IXL,  IYF  TO  IYL,  IZF  TO  IZL .  MEL03300 

XCONPOR   MUST   NOT   BE  USED  IN  CONJUNCTION  WITH  EXPLICIT  MEL03310 

SETTINGS  OF  THE  ARRAYS  (INCLUDING  SETTINGS  VIA  CR) .  MEL03320 

MEL03330 

-  GROUP  8. DEPENDENT  VARIABLES  TO  BE  SOLVED  FOR  OR  STORED  :  MEL03340 
S0LVARC1-25K25X.F.>,ST0VARC1-25X25X.F.>,C0NC1C1-4X4X.T.>  MEL  03350 
USE  FOLLOWING  NAMED  INTEGERS  FOR  ARRAY  ELEMENTS  1-20:  MEL03360 
P1,PP,U1,U2,V1,V2,W1,W2,M1,M2,RS,KE,EP,H1,H2,H3,C1,C2,C3,C4.  MEL  0337  0 
SOLVAR    CP1)=.TRUE.  MEL03380 

MEL03390 
MEL03400 
MEL03410 
MEL03420 
MEL03430 
MEL03440 
MEL03450 
MEL03460 
MEL03470 
MEL03480 
MEL03490 
MEL03500 
MEL03510 
MEL03520 
MEL03530 

GROUP    9.    VARIABLE    LABELS    :  MEL03540 

TITLEC1-25X2HP1,2HPP,2HU1,2HU2,2HV1,2HV2,2HW1,2HW2,2HR1,  MEL  03550 

2HR2,2HRS,2HKE,2HEP,2HH1,2HH2,2HH3,2HC1,2HC2,  MEL  0356  0 

2HC3,2HC4,2HRX,2HRY,2HRZ,    2*4Hxxxx>  MEL03570 

TITLECU1)=TITEM0  MEL03580 

TITLECU2)=TITEMP  MEL03590 

TITLE(PP)=TITDEN  MEL03600 


SOLVAR 

(PP)  = 

.TRUE. 

SOLVAR 

(Vl)  = 

.TRUE. 

SOLVAR 

(V2)  = 

.TRUE. 

SOLVAR 

(Rl)  = 

.TRUE. 

SOLVAR 

(R2)  = 

.TRUE. 

SOLVAR 

(RS)  = 

.TRUE. 

SOLVAR 

(Hl)  = 

.TRUE. 

SOLVAR 

(H2)  = 

.TRUE. 

SOLVAR 

(Cl)  = 

.TRUE. 

SOLVAR 

(C2)  = 

.TRUE. 

SOLVAR 

(C3)  = 

.TRUE. 

STOVAR 

(Ul)  = 

.TRUE. 

STOVAR 

(U2)  = 

.TRUE. 

STOVAR 

(24)  = 

.TRUE. 
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GROUP    10    PROPERTIES: 

IRHOX1>,IRH02<1>,RHOK1.0>,RH02<1 

ARHOX1.0>,BRHOK1.0>,CRH01<1.0> 

IEMUK1>,EMUK1.0>,EMULAM<1.E-10> 

IHSAT,H1SAT,H2SAT,PSATEX<1.0> 


0>, 


SIGMA(1-25X1.0, 

2 

0,1 

,1 

E10,l.,l 

4x1.0,1.314,1.0, 

1 

E10, 

10X1 

.0> 

IRH01=-1 

IEMU1=-1 

IRH02=-1 

SIGMA(6)=1.E10 

SIGMA(15)=1.E10 

SIGMA(H1)=-1 

SIGMA(C1)=-1 

SIGMA(C2)=-1 

SIGMA(C3)=-1 

E10,1.,1.E10. 


GROUP  11  INTER-PHASE  TRANSFER  PROCESSES  : 

ICFIP,CFIPS,IMD0T,CMD0T,CA1K1.E6>,CA2K1.E6> 

ICFIP=    1 

CFIPS=5E07 

IMDOT=-l 


GROUP    12    SPECIAL    SOURCES    : 
ISPCS0(1-25),AGRAVX,AGRAVY,AGRAVZ,ABU0Y,HREF 


GROUP    13    INITIAL    FIELDS 
FIINITC 1-25X25X1.  E-10> 

FIINIT(6)=1.E-10 

FIINIT(15)=1.E-10 

FIINIT(l)    =100000. 

FIINIT(5)=10101 

FIINIT(9)=10101 

FIINIT(14)=10101 

FIINIT(17)=10101 

FIINIT(18)=10101 

FIINIT(19)=10101 

FIINIT(10)=0.0 


GROUP  14  BOUNDARY/INTERNAL  CONDITIONS  : 
ILOOP1,ILOOPN,XCYCLE<.F.>,PBAR,REGION(1-10X10X.T.> 
XN.B.  ALL  10  REGIONS  ARE  DEFAULTED  .TRUE..   THE  USER  SHOULD 
SET  REGION(I)=. FALSE.  FOR  UNUSED  REGIONS  »I». 
DO  140  1=1,10 
REGI0N(I)=. FALSE. 


GROUP  15  TO  24;  REGIONS  1  TO  10 

ONLY  THOSE  REGIONS  ARE  ACTIVE  WHICH  ARE  SPECIFIED  BY  THE 

USER,  PREFERABLY  BY  WAY  OF:- 

CALL  PLACE(IREGN,TYPE,IXF,IXL,IYF,IYL,IZF,IZL)  & 

CALL  COVAL(IREGN,VARBLE,COEFF, VALUE) 

CALL  PLACE(l,SOUTH,l,NX,l,l,l,NZ) 

CALL  PLACE(3,NORTH,1,NX,100,100,1,NZ) 

CALL  C0VALC3, Ml, FIXVAL, 100000.) 

CALL  C0VAL(3,M2,FIXVAL, 100000.) 


GROUP  25  GROUND  STATION  : 
GROSTA<.F.>,NAMLST<.F.> 
GROSTA=.TRUE. 
XNAMLST  ACTIVATES  NAMELIST  IN  GROUND, 


GROUP  26  SOLUTION  TYPE  AND  RELATED  PARAMETERS 
WHOLEP< . F . >, SUBPST< . F . >, DONACC< . F . > 


GROUP  27  SWEEP  AND  ITERATION  NUMBERS  : 

FSWEEP<1>,LSWEEP<1>,LITHYD<1>,LITC<1>,LITKE<1>,LITH<1>, 

LSWEEP=20 

LITER(  1-25X9x1,-1, 15X1  > 

LITER(2)=  50 

LITER(17)=20 

LITER(18)=20 


MEL03610 
MEL03620 
MEL03630 
MEL03640 
MEL03650 
MEL03660 
MEL03670 
MEL03680 
MEL03690 
MEL03700 
MEL03710 
MEL03720 
MEL03730 
MEL03740 
MEL03750 
MEL03760 
MEL03770 
MEL03780 
MEL03790 
MEL03800 
MEL03810 
MEL03820 
MEL03830 
MEL03840 
MEL03850 
MEL03860 
MEL03870 
MEL03880 
MEL03890 
MEL03900 
MEL03910 
MEL03920 
MEL03930 
MEL03940 
MEL03950 
MEL03960 
MEL03970 
MEL03980 
MEL03990 
MEL04000 
MEL04010 
MEL04020 
MEL04030 
MEL04040 
MEL04050 
MEL04060 
MEL04070 
MEL04080 
MEL04090 
MEL04100 
MEL04110 
MEL04120 
MEL04130 
MEL04140 
MEL04150 
MEL04160 
MEL04170 
MEL04180 
MEL04190 
MEL04200 
MEL04210 
MEL04220 
MEL04230 
MEL04240 
MEL04250 
MEL04260 
MEL04270 
MEL04280 
MEL04290 
MEL04300 
MEL04310 
MEL04320 
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LITER(19)=20  MEL04330 
IVELF<1>,NVEL<1>,IVELL<1000  0>,  MEL  04340 
IKEF<1>,NKE<1>,IKEL<10  0  00>,  MEL  04350 
IENTF<1>,NENT<1>,IENTL<10000>,  MEL  0436  0 
ICNCF<1>,NCNC<1>,ICNCL<10  00  0>,  MEL  0437  0 
IRH01F<1>,NRHOX1>,IRH01L<10000>,  MEL  0438  0 
IRH02F<1>,NRH02<1>,IRH02L<10000>  MEL  0439  0 
MEL04400 

-  GROUP  28  TERMINATION  CRITERIA  :  MEL04410 
ENDIT(l-25X9xl.E-10,0.5,15xl.E-10>  MEL  04420 

MEL04430 

-  GROUP  29  RELAXATION  :  MEL04440 
RLXP<1.>,RLXPXY<1.>,RLXPZ<1.>,RLXRH0<1.>,RLXMDT<1.>,  MEL  04450 
RLXRHO=0.2  MEL04460 
DTFALS(Cl)=4.E-5  MEL04470 
DTFALS(C2)=4.E-5  MEL04430 
DTFALS(C2)=4.E-5  MEL04490 
DTFALS(3-25X23X1.E10>  MEL04500 

MEL04510 

-  GROUP  30  LIMITS  :  MEL04520 

VELMAX<1.E10>,VELMIN<-1.E10>,RHOMAX<1 . E10>, RH0MIN<1 . E-l 0>,  MEL  0  4530 

TKEMAX<1 . E10>,TKEMIN<1 . E-10>, EMUMAX<1 . El 0>, EMUMIN<1 . E-10>,  MEL  04540 

EPSMAX<1.E10>,EPSMIN<1.E-10>,AMDTMX<1.E10>,AMDTMN<-1.E10>  MEL  04550 
MEL04560 

-  GROUP  31  SLOWING  DEVICES  :  SL0RH0<1 . >, SL0EMU<1 . >  MEL04570 


MEL04530 

GROUP  32  PRINT-OUT  OF  VARIABLES  :  MEL04590 

PRINT(1-25X.T.  ,  .F.  ,  23*  .  T  .  >,  SUBWGR<  .  F.  >  MEL  046  0  0 

PRINT(U1)=.TRUE.  MEL04610 

PRINTCU2X.TRUE.  MEL04620 

PRINT(PP)=.TRUE.  MEL04630 

PRINT(24)=.TRUE.  MEL04640 

MEL04650 

GROUP  55    MONITOR  PRINT-OUT  :  MEL04660 

IYM0N=25  MEL04670 

IXMON<l>,IYMON<l>,IZMON<l>,NPRMON<l>,NPRMNT<l>  MEL  0  4680 

MEL04690 

GROUP  34  FIELD  PRINT-OUT  CONTROL  i  MEL04700 
NPRINT<100>,NTPRIN<10  0>,NXPRIN<1>,NYPRIN<1>,NZPRIN<1>,  MEL  047 10 
IZPRF<1>,ISTPRF<1>,IZPRL<10  000>,ISTPRL<10  0  00>  MEL  047 20 
NUMCLS<10>,KOUTPT  MEL04730 
KOUTPT=-l  MEL04740 
NTPRIN=1  MEL04750 
MEL04760 

GROUP  35  TABLE  CONTROL  i  MEL04770 

TABLES<.F.>,NTABLE,NTABVR,LINTAB,NPRTAB,NMON,  MEL  0478  0 

ITAB(l-8),MTARVR(l-8)  MEL04790 

MEL04800 

GROUP  36-38  ARE  NOT  DOCUMENTED  IN  THE  INSTRUCTION  MEL04810 
MANUAL  AND  ARE  INTENDED  FOR  MAINTENANCE  PURPOSES  ONLY  MEL04820 
GROUP  36  DEBUG  PRINT-OUT  SLAB  AND  TIME-STEP  i  MEL04830 
IZPRX1>,IZPR2<1>,ISTPRK1>,ISTPR2<1>  MEL  04840 
MEL04850 

GROUP  37  DEBUG  SWEEP  AND  SUBROUTINES  :  MEL04860 
KEMU,KMAIN,KINDEX,KGEOM,KINPUT,KSODAT,KCOMPF,KSORCE,  MEL  0487  0 
KS0LV1,KS0LV2,KS0LV3,KC0MPP,KADJST,KFLUX,KSHIFT,KDIF,  MEL  04880 
KCOMPU,KCOMPV,KCOMPW,KCOMPR,KWALL,KDBRHQ<-l>,KDBEXP,KDBMDT  MEL  04890 
KDBGEN  MEL04900 
MEL04910 

GROUP  38  MONITOR, TEST, AND  FLAG  t  MEL04920 

MONITR< . F . >, FLAG< . F . >, TEST< .T . >, KFLAG<1>  MEL  04930 

END  OF  MAINTENANCE-ONLY  SECTION  MEL04940 

MEL04950 

GROUP  39  ERROR  AND  RESIDUAL  PRINT-OUT  :  MEL04960 

IERRP<10  00>,RESREF(1,3-24X25*1.>,RESMAP<.F.>,  MEL  0497  0 

RESID(1-25X2*.F.,23X.T.>,K0UTPT  MEL  04980 

IERRP=LSWEEP  MEL04990 

RESREF(l)=5.E-5  MEL05000 

RESREF(Vl)=5.E-5  MEL05010 

RESREF(V2)=5.E-5  MEL05020 

RESREF(H1)=40.  MEL05030 

RESREF(H2)=40.  MEL05040 
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RESREF(Cl)=5.E-5 
RESREF(C2)=5.E-5 
RESREF(C3)=5.E-5 


GROUP  40  SPECIAL  DATA  :  L0GICC1 . . 10), INTGRC1 . . 10), REC21 . .30), 

NLSP<1>,NISP<1>,NRSP<1>,SPDATA<.F.>,LSPDA(1),ISPDA(1),RSPDA(1) 
USE  FIRST  10  ELEMENTS  OF  ARRAYS  LOGIC  &  INTGR  AND  21ST 
TO  30TH  OF  ARRAY  RE  FOR  TRANSFERRING  SPECIAL  DATA  FROM 
SATELLITE  TO  GROUND,  BUT  IF  REQUIREMENTS  EXCEED  THIS 
PROVISION  SET  SPDATA  =  .T.,  AND  DIMENSION  ARRAYS  LSPDA, 
ISPDA,  RSPDA  ABOVE  AND  IN  GROUND  AS  NEEDED,  AND  SET  HERE 
NLSP,  NISP,  NRSP  TO  DIMENSION  VALUES. 


-   GROUP  42  RESTARTS  AND  DUMPS  :  SAVEM< . F . >, RESTRT< . F . >, KINPUT 


GROUP  43  GRAFFIC  i 

GRAPHS< . F . >, ORTHOG< . T . >, ANTSYM, NPRT<1> , ITITL<5*4H*XX*> 

FOR  A  GRAFFIC  RUN,  DIMENSION  PHI1  5  PHI2  AS  FOLLOWS: 

PHI1(NXXNY*NZ*NM) 

PHI2((NX+2)*(NY+2)X(NZ+2)*(NM+IBLK))  '  WHERE 
NM=NO.  OF  VARIABLES  STORED  +  DENSITY( -IES) 
IBLK=0  IF  BLOCK=. FALSE. ,=4  IF  A  3D  RUN, 
=3  IF  A  2D.YZ  RUN. 


IF(IRUN.EQ.l)  GO  TO  900 
RUN2 

IFCIRUN.EQ.2)  GO  TO  900 
RUN3 

IFCIRUN.EQ.3)  GO  TO  900 
RUN4 

IFCIRUN.EQ.4)  GO  TO  900 
RUN5 

IF(IRUN.EQ.5)  GO  TO  900 
RUN6 

IFCIRUN.EQ.6)  GO  TO  900 
RUN7 

IFCIRUN.EQ.7)  GO  TO  900 
RUN8 

IFCIRUN.EQ.8)  GO  TO  900 
RUN9 

IFCIRUN.EQ.9)  GO  TO  900 
RUN10 

IFCIRUN.EQ.10)  GO  TO  900 
RUN11 

IF(IRUN.EQ.ll)  GO  TO  900 
RUN12 

IFCIRUN.EQ.12)  GO  TO  900 
RUN13 

IFCIRUN.EQ.13)  GO  TO  900 
RUN14 

IFCIRUN.EQ.14)  GO  TO  900 
RUN15 

IFCIRUN.EQ.15)  GO  TO  900 
RUN16 

IFCIRUN.EQ.16)  GO  TO  900 
RUN17 

IFCIRUN.EQ.17)  GO  TO  900 
RUN18 

IFCIRUN.EQ.18)  GO  TO  900 
RUN19 

IFCIRUN.EQ.19)  GO  TO  900 
RUN20 

IFCIRUN.EQ.20)  GO  TO  900 
RUN21 

IFCIRUN.EQ.21)  GO  TO  900 
RUN22 

IFCIRUN.EQ.22)  GO  TO  900 
RUN23 

IFURUN.EQ.23)  GO  TO  900 
RUN24 

IFCIRUN.EQ.24)  GO  TO  900 
RUN25 


MEL05050 
MEL05060 
MEL05070 
MEL05080 
MEL05090 
MEL05100 
MEL05110 
MEL05I20 
MEL05130 
MEL05140 
MEL05150 
MEL05160 
MEL05170 
MEL05180 
MEL05190 
MEL05200 
MEL05210 
MEL05220 
MEL05230 
MEL05240 
MEL05250 
MEL05260 
MEL05270 
MEL05280 
MEL05290 
MEL05300 
MEL05310 
MEL05320 
MEL05330 
MEL05340 
MEL05350 
MEL05.360 
MEL05370 
MEL05380 
MEL05390 
MEL05400 
MEL05410 
MEL05420 
MEL05430 
MEL05440 
MEL05450 
MEL05460 
MEL05470 
MEL05480 
MEL05490 
MEL05500 
MEL05510 
MEL05520 
MEL05530 
MEL05540 
MEL05550 
MEL05560 
MEL05570 
MEL05580 
MEL05590 
MEL05600 
MEL05610 
MEL05620 
MEL05630 
MEL05640 
MEL05650 
MEL05660 
MEL05670 
MEL05680 
MEL05690 
MEL05700 
MEL05710 
MEL05720 
MEL05730 
MEL05740 
MEL05750 
MEL05760 
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IF(IRUN.EQ.25)  GO  TO  900 

•  RUN26 

IFdRUN.EQ.26)  GO  TO  900 

•  RUN27 

IF(IRUN.EQ.27)  GO  TO  900 

■  RUN28 

IF(IRUN.EQ.28)  GO  TO  900 
-   RUN29 

IF(IRUN.EQ.29)  GO  TO  900 

■  RUN30 

IF(IRUN.EQ.30)  GO  TO  900 
10  CONTINUE 

•  ALL  RUNS 

[XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  USER  SECTION  3  ENDS. 
[XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  STANDARD  SECTION  <+  STARTS 

IRITE  GENERAL  DATA  ON  TO  THE  GUSIE1.DTA  TAPE,  ETC... 

IF(SPDATA)  CALL  WRTSPCC LSPD4 , NL3P, ISPDA, NISP , RSPDA, NRSP) 

IF(BLOCK)  CALL  WRTPORC PE, PN , PH , PC, NX, NY, NZ, IPLANE) 
OLD  PRACTICES  RETAINED  FOR  REFERENCE: 

IF(SPDATA)  CALL  SPCDAT(IRUN) 

IF(BLOCK)  CALL  PORDAT(IRUN) 

IF(GRAPHS)  CALL  SORT(IRUN) 

IF(RESTRT)  GO  TO  902 
DO  901  INDVAR=1,25 

IF(IFIX(FIINIT(INDVAR)+0.1) .NE. 10101)  GO  TO  901 
CALL  FLDDAT(IRUN) 
GO  TO  902 

1  CONTINUE 

2  CALL  DATAIO(WRT,10) 

IF(MONITR)  CALL  DATAIO( WRT, -6 ) 
CONTINUE 
STOP 
END 
RECTIVE**FLDDAT 
XFILE  NAME:  MODFLD.FTN 

^ABSTRACT:  SATELLITE  MODEL  FLDDAT  SUBROUTINE. 
^DOCUMENTATION:  PHOENICS  INSTRUCTION  MANUAL  (SPRING  1983). 
SUBROUTINE  FLDDAT(IRUN) 

FIELDS  IS  USED  TO  SPECIFY  NON-UNIFORM  INITIAL  FIELDS. 
EARTH  SETS  UNIFORM  INITIAL  FIELDS  TO  FIINIT(MPHI ) ,  EXCEPT 
WHEN  FINIIT(MPHI)=10101.0  WHICH  IS  THE  SIGNAL  THAT  EARTH 
READS  THE  NON-UNIFORM  FIELDS  TAPE  THE  CONTENTS  OF  WHICH 
ARE  SET  HERE. 

IT  IS  ESSENTIAL  TO  PROVIDE  SETTINGS  FOR  ALL  THOSE  MPHI'S 
FOR  WHICH  FIINIT(MPHI)  HAS  BEEN  SET  TO  10101. THE  SETTING 
ORDER  MUST  FOLLOW  THE  STANDARD  ORDER  OF  BLOCK  DATA. 
NOTE:  EARTH  PRINTS  OUT  THE  INITIAL  FIELDS  IF  KOUTPT=-l. 

PLEASE  NOTE  THAT  THE  PHI  ARRAY   M  U  S  T  BE  SET  AS 
PHI(IY,IX)=. . .,NOT  AS  PHI(IX,IY)=. . . 
ALSO,  YOU   MUST   DIMENSION  PHI  TO  THE  MAXIMUM 
DIMENSIONS  USED  IN  THE  RUNS  DEFINED  IN  SATLIT,  VIZ. 
DIMENSION  PHKNY  MAX., NX  MAX.) 


TER  1 


PRELIMINARIES 


CLUDE  9,CMNGUSSI.FTN/G 

LOGICAL  LOGIC1, LOGIC 

DIMENSION  LOGIC(IOO) 

C0MM0N/LDATA/L0GICK309) 

EQUIVALENCE  (  LOGIC(  1 ) ,  LOGICK210)  ) 

DIMENSION  INTGR(IOO) 

C0MM0N/IDATA/INTGR1C194) 

EQUIVALENCE  ( INTGRC 1 ) , INTGR1 (95) ) 

DIMENSION  RE(IOO) 

C0MM0N/RDATA/REH421) 

EQUIVALENCE  ( RE( 1 ) , RE1 ( 322) ) 

COMMON/BOUND/ LOCREG(60), 
&TR1,CP1R1(7),VP1R1(7),CP2R1(5),VP2R1(5),CPNR1(5),VPNR1(5), 
8TR2,CP1R2(7),VP1R2(7),CP2R2(5),VP2R2(5),CPNR2(5),VPNR2(5), 


MEL05770 
MEL05780 
MEL05790 
MEL05800 
MEL05810 
MEL05820 
MEL05830 
MEL05840 
MEL05850 
MEL05860 
MEL05870 
MEL05880 
MEL05890 
MEL05900 
MEL05910 
MEL05920 
MEL05930 
MEL05940 
MEL05950 
MEL05960 
MEL05970 
MEL05980 
MEL05990 
MEL06000 
MEL06010 
MEL06020 
MEL06030 
MEL06040 
MEL06050 
MEL06060 
MEL06070 
MEL06030 
MEL06090 
MEL06100 
MEL06110 
MEL06120 
MEL06130 
MEL  06140 
MEL06150 
MEL06160 
MEL06170 
MEL06180 
MEL06190 
MEL06200 
MEL06210 
MEL06220 
MEL06230 
MEL06240 
MEL06250 
MEL06260 
MEL06270 
MEL06280 
MEL06290 
MEL06300 
MEL06310 
MEL06320 
MEL06330 
MEL06340 
MEL06350 
MEL06360 
MEL06370 
MEL06380 
MEL06390 
MEL06400 
MEL06410 
MEL06420 
MEL06430 
MEL06440 
MEL06450 
MEL06460 
MEL06470 
MEL06480 
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aTR3,CPlR3(7),VPlR3(7),CP2R3(5),VP2R3(5),CPNR3(5),VPNR3(5),  MEL  06490 

8TR4,CP1R4(7),VP1R4(7),CP2R4(5),VP2R4(5),CPNR4(5),VPNR4(5),  MEL  06  500 

8TR5,CP1R5(7),VP1R5(7),CP2R5(5),VP2R5(5),CPNR5(5),VPNR5(5),  MEL  06 510 

&TR6,CP1R6(7),VP1R6(7),CP2R6(5),VP2R6(5),CPNR6(5),VPNR6(5),  MEL  06 520 

8TR7,CP1R7(7),VP1R7(7),CP2R7(5),VP2R7(5),CPNR7(5),VPNR7(5),  MEL  06530 

8TR8,CP1R8(7),VP1R8(7),CP2R8(5),VP2R8(5),CPNR8(5),VPNR8(5),  MEL  06 540 

STR9,CP1R9(7),VP1R9(7),CP2R9(5),VP2R9(5),CPNR9(5),VPNR9(5),  MEL  06550 

8TR10,CP1R10(7),VP1R10(7),CP2R10(5),VP2R10(5),CPNR10(5),VPNR10(5)   MEL  06 56  0 

DIMENSION  TCVREG(350)  MEL06570 

EQUIVALENCE  (TCVREG( 1 ) , TR1 )  MEL06580 

C$INCLUDE  9,GUSSEQUI.FTN/G  MEL06590 

LOGICAL  CARTES, POLAR, SPDATA, SKEW, TWODYZ, ONEDZ, STOVAR( 25),  MEL  066 0  0 

8    S0LVAR(25),PRINT(25),RESID(25),CMPRSS,C0NEMU,LSP1,  MEL06610 

8    CONRHO,EMDOT,ONEPHS,INCORE(10),ISAVED,SAVEI,SAVEM,  MEL06620 

8    RESTRT,XCYCLE,MONITR,REGION( 10), STEADY, WHOLEP, SLABPP,  MEL  066  30 

8    RAIN, BL0CKZ,PWSTAG,RUN(30), PLOT, RESMAP, FLAG, BLOCK,  MELQ6640 

5    TEST,  C0NCK4),  DISTIL  MEL06650 

LOGICAL  SPRESS,PARAB, DONACC, OVERLY, SACC,  MEL06660 

8    GUSSIE, CATHY, CONNIE, CORA, ESTER, FLASH, FLORA,  MEL06670 

8    FOCS,GENMIX, HESTER, PICALO, PLANT, SPLASH, HELGA,  MEL06680 

8    TACT, TIBALT,TOPSI, PAMELA, TABLES, WSTAG,  MEL06690 

8    CONMOD,GROSTA,SUBPST,SUBWGR  MEL06700 

EQUIVALENCE  (CARTES, LOGIC1 ( 1 )),( POLAR, LOGIC1 ( 2) ) ,  MEL06710 

8    (SPDATA,L0GIC1(3)),( SKEW, LOGICK 4)), (TWODYZ, LOGICK 5)),  MEL  067 20 

8    (0NEDZ,L0GIC1(6)),(ST0VAR(1),L0GIC1(7)),  MEL06730 

8    (S0LVAR(1),L0GIC1(32)),(PRINT(1),L0GIC1(57)),  MEL06740 

8    (RESID(1),LOGICK82)),(CMPRSS,LOGICK107)),  MEL06750 

8    (CONEMU,LOGICK108)),(LSP1,LOGICK109)),  MEL06760 

8    (CONRHO,LOGIC1(110)),(EMDOT,LOGIC1(111)),  MEL06770 

8    (0NEPHS,L0GIC1(112)),(INC0RE(1),L0GIC1(113))  MEL06780 

EQUI VAL  ENCE(ISAVED,L0GICK1 23)  ),(SAVEI,  LOGICK  124)),  MEL  067 9  0 

8    (SAVEM,L0GIC1(125)),(RESTRT,LQGIC1(126)) .  MEL06800 

8    (XCYCLE,L0GIC1(127)),(M0NITR,L0GIC1(128)),  MEL06810 

8    (REGI0N(1),L0GICK129)), (STEADY, LOGIC1 ( 139 ) ) ,  MEL06820 

8    (WHOLEP, LOGICK140)), (SLABPP, LOGIC1 ( 141 ) ) ,  MEL06830 

8    (RAIN,L0GICK142)),(BL0CKZ,L0GICK143)),  MEL06840 

8    (PWSTAG,L0GICK144)),(RUN(1),L0GICK145)),  MEL06850 

8    (PL0T,L0GIC1(175)),(RESMAP,L0GIC1(176)),  MEL06860 

8    ( FLAG, LOGIC1 ( 177 )),( BLOCK, LOGICK 178 )),( TEST, LOGICK 179))  MEL  0687  0 

EQUIVALENCE(C0NC1(1),L0GIC1(206))  MEL  06880 

EQUIVALENCE  (SPRESS, LOGIC( 100 ) ) , (PARAB, L0GIC(99) ) ,  MEL06890 

8    (DONACC, L0GIC(98))  MEL06900 

EQUIVALENCE  ( OVERLY, L0GIC(96 )), (SACC, L0GIC(95) ) ,  MEL06910 

8    (WSTAG, L0GIC(94))  MEL06920 

EQUIVALENCE  ( DISTIL , LOGIC( 90 ) )  MEL06930 

EQUIVALENCE  ( PAMELA, L0GIC(67 )), (TOPSI , LOGIC(66 )) ,  MEL06940 

8    ( TIBALT,L0GIC(65)),( TACT, L0GIC(64)),( HELGA, LOGIC( 63)),  MEL  06 950 

8    (SPLASH, L0GIC(62)), (PLANT, LOGIC(6D), (PICALO, L0GIC(60)),  MEL  06 96  0 

8    (HESTER,L0GIC(59)),(GENMIX,L0GIC(58)),(F0CS,L0GIC(57)),  MEL  0697  0 

8    ( FLORA, LOGIC( 56 )),( FLASH, LOGIC( 55 )),( ESTER, L0GIC(54)),  MEL  06980 

a    (C0RA,L0GIC(53)),(C0NNIE,L0GIC(52)),(CATHY,L0GIC(5D),  MEL  0699  0 

8    (GUSSIE, LOGIC(50))  MEL07000 

EQUIVALENCE  (TABLES, L0GIC(48) ), (CONMOD, L0GIC(47 )) ,  MEL07010 

8    (GR0STA,L0GIC(46)),(SUBPST,L0GIC(45))  MEL07020 

EQUIVALENCE  ( SUBWGR, LOGIC( 43) )  MEL07030 

INTEGER  FSTEP,FSWEEP,TSTSWP,ITAB(8),MTABVR(8)  MEL07040 

DIMENSION  ISPCS0(25),LITER(25)  MEL07050 

EQUIVALENCE  (NX, INTGR1 ( 1 ) ) , (NY, INTGR1 ( 2) ) ,  MEL07060 

8    (NZ,INTGR1(3)),(ISPCS0(1),INTGR1(4)),  MEL07070 

8    (NREGN,INTGR1(29)),(NPHI,INTGR1(30)),  MEL07080 

8    (LITKE,INTGR1(31)),(LITHYD,INTGR1(32)),  MEL07090 

8    (LITH,INTGR1(33)),(LITCNC,INTGR1(34)),  MEL07100 

8    (LITSLB,INTGR1(35)),(NRUN,INTGR1(36)),  MEL07110 

8    (LITER(1),INTGR1(37)),(FSTEP,INTGR1(62)),  MEL07120 

8    (FSWEEP,INTGR1(63)),(LSTEP,INTGR1(64))  MEL07130 

EQUIVALENCE  ( LSWEEP, INTGR1 (65) ) , ( NPRINT, INTGRK66 ) ) ,  MEL07140 

8    (IERRP,INTGR1(67)),(IMAXP,INTGR1(68)),  MEL07150 

8    (IEMU1,INTGR1(69)),(IXMON,INTGR1(70)),  MEL07160 

8    (IYM0N,INTGR1(71)),(IZM0N,INTGR1(72)),  MEL07170 

8    (KEMU,INTGR1(73)),(KMAIN,INTGR1(74)),  MEL07180 

8    (KINDEX,INTGR1(75)),(KGE0M,INTGR1(76)),  MEL07190 

8    (KINPUT,INTGR1(77)),(KS0DAT,INTGR1(78))  MEL07200 


44 


MEL3SAT   FORTRAN   Al 

EQUIVALENCE(KFLAG,INTGR1(79)),(KC0MPF,INTGR1(80)),  MEL  07 210 

5  (KS0RCE,INTGR1(81)),(KLES1D,INTGR1(82)),  MEL07220 

6  (KLES2D,INTGR1(83)),(KLES3D,INTGR1(84)),  MEL07230 
&  (KC0MPP,INTGR1(85)),(KADJST,INTGR1(86)),  MEL07240 
8  (KFLUX,INTGR1(87)),(KSHIFT,INTGR1(88)),  MEL07250 
8  (KOUTPT,INTGR1(89)),(KDIF,INTGR1(90)),  MEL07260 
8  (KC0MPU,INTGR1(91)),(KC0MPV,INTGR1(92)),  MEL07270 
8  (KC0MPW,INTGR1(93)),(KC0MPR,INTGR1(94))  MEL07280 

EQUIVALENCE  (KELIN, INTGR( 100 ) ) , (MEANDF, INTGR( 99 ) ) ,  MEL07290 

8  (NUMCLS,INTGR(98)),  MEL07300 

8  (IRH01,INTGR(97)),(IRH02,INTGR(96)),  MEL07310 

8  (IZW1,INTGR(95)),(IZW2,INTGR(94)),  MEL07320 

8  (MGRID,INTGR(93)),(KWALL,INTGR(92)),  MEL07330 

8  (IZPR1,INTGR(91)),(IZPR2,INTGR(90)),  MEL07340 

8  (ISTPR1,INTGR(89)),(ISTPR2,INTGR(88)),  MEL07350 

8  (NTPRIN,INTGR(87))  MEL07360 

EQUIVALENCE  ( IMLOT , INTGR(86 ) ) , ( IHSAT, INTGRC85 ) ) ,  MEL07370 

8  (ICFIP,INTGR(84)),(NTABLE,INTGR(83)),(NTABVR,INTGR(82)),  MEL  07 38  0 

8  (LINTAB,INTGR(81)), ( NPRTAB, INTGRC 80 ) ) , ( NMON, INTGRC7  9 ) ) ,  MEL  07 39  0 

8  (ITAB(1),INTGR(71)),  ( MTABVR( 1 ) , INTGR(63) ) ,  MEL07400 

8  (NZPRIN,INTGR(62)),  MEL07410 

8  (NXPRIN,INTGR(61)),(NYPRIN,INTGR(60)),  MEL07420 

8  (LDISTL,INTGR(59)),(TSTSWP,INTGR(58)),  MEL07430 

8  (KDBEXP,INTGR(57)),(KDBRH0,INTGR(56)),  MEL07440 

8  (KDBMDT,INTGR(55))  MEL07450 

EQUIVALENCE  ( IL00P1 , INTGR( 53) ) , ( ILOOPN, INTGR( 52) ) ,  MEL07460 

8  (IPBP,INTGR(51)),  ( IZPRF, INTGR( 50 ) ) ,  MEL07470 

8  (IZPRL,INTGR(49)),(ISTPRF,INTGR(<48)),  MEL07480 

8  (ISTPRL,INTGR(47)),(KDBGEN,INTGR(46)),  MEL07490 

8  (IVELF,INTGR(45)),(IVELL,INTGR(44)),  MEL07500 

8  (IKEF,INTGR(43)),(IKEL,INTGR(<+2)),  MEL07510 

8  (IENTF,INTGR(41)),(IENTL,INTGR(40)),  MEL07520 

8  (ICNCF,INTGR(39)), ( ICNCL , INTGR( 33 ) ) ,  MEL07530 

8  (NVEL,INTGR(37)),(NKE,INTGR(36)),  MEL07540 

8  (NENT,INTGR(35)),  ( NCNC, INTGRC 34 ) ) ,  MEL07550 

8  (NZSTP,INTGR(33)),(NPRMNT,INTGR(32))  MEL07560 

DIMENSION  SPARE1(20),XUDIST(30),YVDIST(30),ZWDIST(50),  MEL07570 

8  SIGMA(25),CRIT(25),DTFALS(25),RESREF(25),  MEL07580 

8  TITLE(25),FIINIT(25),TFRAC(30)  MEL07590 

EQUIVALENCE  ( SPARE1 ( 1 ) , RE1 ( 1 ) ) ,  MEL07600 

8  CTFRAC(1),RE1(21)),(XULAST,RE1(51)),  MEL07610 

8  (YVLAST,RE1(52)),(ZWLAST,RE1(53)),  MEL07620 

8  (XUDIST(1),RE1(54)),(YVDIST(1),RE1(84)),  MEL07630 

8  (ZWDIST(1),RE1(114)),(SIGMA(1),RE1(164)),  MEL07640 

8  (CRIT(1),RE1(189)),(DTFALS(1),RE1(214)),  MEL07650 

8  (RESREF(1),RE1(239)),(EMU1,RE1(264)),  MEL07660 

8  (RH01,RE1(265)),(RH02,RE1(266)),  MEL07670 

8  (TLAST,RE1(267)),(CFIPS,RE1(268))  MEL07680 

EQUIVALENCE  ( AMDOT, RE1 (269 ) ) , ( FIINITC 1 ) , RE1 (270) ) ,  MEL07690 

8  (RELAXP,RE1(295)),(TITLE(1),RE1(296)),  MEL07700 

8  (DT,RE1(321)),  MEL07710 

8  (RINNER,ZWDIST(50)),(SNALFA,ZWDIST(49)),  MEL07720 

8  (PBAR,ZWDIST(48))  MEL07730 

EQUIVALENCE  ( SLOEMU, RE( 100 ) ) , ( SLORHO, RE(99) ) , (RLXRHO, RE(98) ) ,  MEL  077  40 

8  (RH0MAX,RE(97)),(RH0MIN,RE(96)),  MEL07750 

8  (EMUMAX,RE(95)),(EMUMIN,RE(94)),  MEL07760 

8  (TKEMAX,RE(93)),(TKEMIN,RE(92)),  MEL07770 

8  (RLXPZ,RE(91)),  MEL07780 

8  (ABUOY,RE(90)),(HREF,RE(89)),  MEL07790 

8  (AGRAVX,RE(88)),(AGRAVY,RE(87)),  MEL07800 

8  (AGRAVZ,RE(86)),(ATIME,RE(85))  MEL07810 

EQUIVALENCE  (RLXPXY, RE(84) ) ,  MEL07820 

8  (EPSMAX,RE(83)),(EPSMIN,RE(82)),  MEL07830 

8  (ARH01,RE(81)),(BRH01,RE(80)),(CRH01,RE(79))  MEL07840 

EQUIVALENCE  ( AZW2, RE(73) ) , ( BZW2, RE(74) ) ,  MEL07850 

8  (PINT,RE(75)),(CZW2,RE(76)),  MEL07860 

8  (DZ,RE(78)),(ZWL,RE(77)),(ZW2M1T,RE(72)),  MEL07870 

8  (VELMIN,RE(70)),(VELMAX,RE(69)),  MEL07880 

8  (FALC0M,RE(68)),(CMD0T,RE(67)),  MEL07890 

8  (RLXMDT,RE(66)),(AMDTMX,RE(65)),(AMDTMN,RE(6<+)),  MEL07900 

8  (RADMAX,RE(63)),(RADMIN,RE(62)),  MEL07910 

8  (PRESS, RE(61)),(CP1,RE(60)),  MEL07920 
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8    CCP2,REC59)),CCP3,REC58)),CFST0IC,REC57)),  MEL07930 

8    CARRC0N,REC56)),CPREEXP,REC55)),CCA1I,REC54))  MEL07940 

EQUIVALENCE  (CA2I , RE( 53) ) , (CA13, REC52) ) , (CA23, REC51 ) ) ,  MEL07950 

8    CH1SAT,REC50)),CH2SAT,REC49)),  MEL07960 

8    CEMULAM,REC48))  MEL07970 

EQUIVALENCE  CTWPRCN,  RE(  42)  ) ,  (PSATEX,  RE(  41)  )  MEL07980 

EQUIVALENCES  EXP,  RE(  39  )),(EWALL,RE(  38)  ),  MEL  07  99  0 

8    CSIGE,REC37)),CSIGK,REC36)),CTAUDK,REC35))  MEL08000 

DIMENSION  L0C1C6),L0C2C6),L0C3C6),L0C4C6),L0C5C6),  MEL08010 

8    LOC6C6),LOC7C6),LOC8C6),LOC9C6),LOC10C6)  MEL08020 

EQUIVALENCE  C LOCREGC 1 ), LOCI C 1 )), C L0CREGC7 ), L0C2C 1 ) )  MEL08030 

EQUIVALENCE  ( lOCREGC 13) , L0C3( 1) ) , ( LOCREG( 19 ) , L0C4C 1 ) )  MEL08040 

EQUIVALENCE  C LOCREGC 25) , L0C5C 1 )), C LOCREGC 31 ), L0C6C 1 ) )  MEL08050 

EQUIVALENCE  ( LOCREGC 37 ), L0C7 ( 1 )),( LOCREG( 43) , L0C8( 1 ) )  MEL08060 

EQUIVALENCE  C LOCREGC 49 ), LOC9C 1 )), C LOCREGC 55) , LOC10C 1 ) )  MEL03070 

DIMENSION  XUFRACC30),YVFRACC30),ZWFRACC30),ENDITC25)  MEL03080 

DIMENSION  XFRACC30),YFRACC30),ZFRACC30)  MEL08090 

EQUIVALENCE(XUDISTC1),XUFRAC(1),XFRACC1)),  MEL  081 00 

8  CYVDISTC1),YVFRACC1),YFRACC1)),  MEL08110 

8  CZWDISTC1),ZWFRAC(1),ZFRACC1)),CLITCNC,LITC),  MEL08120 

8  CENDITC1),CRITC1)),CRLXP,RELAXP)  MEL08130 

EQUIVALENCE  C NPRMON, LITERC 1 ) )  MEL08140 

DIMENSION  PHIC100,1),FDTAPEC3)  MEL08150 

INTEGER  FTAPE  MEL08160 

LOGICAL  FIRST  MEL08170 

INTEGER  P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS,EP,H1,H2,H3,C1,C2,  MEL 08 18  0 

SC3,C4  MEL08190 

DATA  P1,PP,U1,U2,V1,V2,W1,W2,R1,R2,RS,KE,EP,H1,H2,H3,C1,C2,  MEL 0820  0 

8C3,C4/1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  20/  MEL  08210 

DATA  FIRST, FTAPE, FDTAPE/. TRUE. ,9, 4HFIEL , 4HDS . D, 2HTA/  MEL08220 

IFCFIRST)  CALL  TAPESC FTAPE, FDTAPE, 3, 1 , 4*NX*NY)  MEL08230 

FIRST=. FALSE.  MEL08240 

c MEL  08250 

CHAPTER  2   USER  CHAPTER  FOR  SETTING  INITIAL  FIELDS.  MEL08260 

c MEL  0827  0 

NNZ=NZ  MEL08280 

IFCPARAB)  NNZ=1  MEL08290 

DO  2000  IZ=1,NNZ  MEL08300 

DO  2000  MPHI=1,25  MEL08310 

IFCMPHI.EQ.2)  GO  TO  2000  MEL08320 

IFCIFIXCFIINITCMPHD  +  O.D.NE. 10101)  GO  TO  2000  MEL08330 

IFC .NOT.STOVARCMPHD.AND. . NOT . SOLVARCMPHI ) )  GO  TO  2000  MEL08340 

CxxxxxxxxxxxxxiJSER  SECTION  STARTS  HERExxxxxxxxxxxx  MEL08350 

C     FOR  EACH  VARIABLE,  MVAR,  FOR  WHICH  FIINITCMVAR)  IS  SET  TO  MEL08360 

C     10101.0  IN  BLOCK  DATA,  THE  USER  MUST  INSERT  HERE  FORTRAN  MEL08370 

C     STATEMENTS  FOR  SETTING  HIS  WANTED  NON-UNIFORM  INITIAL  FIELD.  MEL08380 

C     THE  FORTRAN-STATEMENT  MODEL  TO  BE  FOLLOWED  BY  THE  USER  FOR  MEL08390 

C     EACH  MVAR  IS  AS  FOLLOWS...  MEL08400 

C  MEL08410 

C         IFCMPHI.NE.MVAR)  GO  TO  205  MEL08420 

C       DO  201  IX=1,NX  MEL08430 

C       DO  201  IY=1,NY  MEL08440 

C  201  PHICIY,IX)  = USER  INSERTS  FIELD  VALUE  AT  IX,IY,IZ  HERE.     MEL08450 

C     WRITECFTAPE)  C CPHI C IY, IX) , IY=1 , NY) , IX=1 , NX)  MEL08460 

C  205  CONTINUE  MEL08470 

C  MEL08480 

C      INSERT  HERE  ADDITIONAL  FORTRAN  SEQUENCES,  SIMILAR  TO  THAT  MEL08490 

C     GIVEN  ABOVE,  FOR  EACH  MVAR  FOR  WHICH  FIINITCMVAR)=10101 . 0  MEL08500 

CxxxxxxxxxxxxxuSER  SECTION  ENDS  HERE   xxxxxxxxxxxx  MEL08510 

WRITEC6,X)  «xxxxxx  BEGINNING  ',MPHI  MEL08520 

IF  CMPHI.NE.  5)  GOTO  210  MEL08530 

DO  201  IY=1,25  MEL08540 

201  PHICIY,1)=0.0  MEL08550 
DO  202  IY=26,28  MEL08560 

202  PHICIY,1)=0.0375  MEL08570 
DO  203  IY=29,100  MEL08580 

203  PHICIY,1)=0. 00001  MEL08590 
WRITEC FTAPE) C PHI CIY,1),IY=1, 100)  MEL  086 00 

WRITEC6,X)  • WRITTEN    ',MPHI  MEL08610 

GOTO  270  MEL08620 

210  IF  CMPHI.NE.  9)  GOTO  230  MEL08630 

DO  211  IY=1,100  MEL08640 
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.E:  MEL3SAT   FORTRAN   Al 

ill  PHICIY,1)=1.0  MEL08650 

WRITE(FTAPE)(PHI(IY,1),IY=1,100)  MEL  0866  0 

WRITE(6,*)  ■ WRITTEN    ',MPHI  MEL08670 

GOTO  270  MEL08680 

>30  IF  (  MPHI  .NE.  14  )  GOTO  240  MEL08690 

DO  213  IY=1,25  MEL08700 

>13  PHI(IY,1)=1.58E06  MEL08710 

PHI(26,1)=3.486E06  MEL08720 

PHI(27,1)=6.670E06  MEL08730 

PHI(28,1)=6.770E06  MEL08740 

PHI(29,1)=6.3E06  MEL08750 

PHI(30,1)=4.225E06  MEL08760 

PHI(31,1)=2.22E06  MEL08770 

PHI(32,1)=2.37E05  MEL08780 

PHI(33,1)=-1.72E06  MEL08790 

PHI(34,1)=-3.2E06  MEL08300 

PHI(35,1)=-6.57E06  MEL08310 

PHI(36,l)=-7 .03E06  MEL08820 

DO  216  IY=37,100  MEL03330 

!16  PHI(IY,1)=-1.28E07  MEL08340 

WRITE(FTAPE)(PHI(IY,1),IY=1,100)  MEL  03350 

WRITE(6,X)  « WRITTEN    ',MPHI  MEL08860 

GOTO  270  MEL08870 

!40  IF  (  MPHI  .NE.  17  )  GOTO  250  MEL08880 

DO  217  IY=1,25  MEL08890 

!17  PHICIY,1)=1.0  MEL08900 

PHI(26,1)=0.9  MEL03910 

PHI(27,1)=0.3  MEL08920 

PHI(28,1)=0.7  MEL08930 

PHI(29,1)=0.6  MEL08940 

PHI(30,1)=0.5  MEL03950 

PHK31, 13  =  0.4  MEL03960 

PHI(32,1)=0.3  MEL08970 

PHI(33,1)=0.2  MEL08980 

PHI(34,1)=0.1  MEL08990 

PHI(35,1)=1 .E-10  MEL09000 

DO  219  IY=36,100  MEL09010 

:19  PHI(IY,1)=1.E-10  MEL09020 

WRITECFTAPE)(PHI(IY,1),IY=1,100)  MEL  09 030 

WRITE(6,*)  « WRITTEN    ',MPHI  MEL09040 

GOTO  270  MEL09050 

150  IF  (  MPHI  .NE.  18  )  GOTO  260  MEL09060 
DO  251  IY=1,25  MEL09070 

151  PHI(IY,1)=1.E-10  MEL09080 
PHI(26,1)=0.05  MEL09090 
PHI(27,1)=0.155  MEL09100 
PHI(28,1)=0.26  MEL09110 
PHI(29,1)=0.365  MEL09120 
PHI(30,1)=0.47  MEL09130 
PHI(31,1)=0.575  MEL09140 
PHK32, 1)  =  0.68  MEL09150 
PHI(33,1)=0.785  MEL09160 
PHI(34,1)=0.89  MEL09170 
PHI(35,1)=1.0  MEL09180 
DO  253  IY=36,100  MEL09190 

!53  PHI(IY,1)=1.0  MEL09200 

WRITE(FTAPEKPHICIY,1),IY  =  1,100)  MEL  09210 

WRITE(6,X)  ' WRITTEN    SMPHI  MEL09220 

GOTO  270  MEL09230 

!60  IF(MPHI  .NE.  19  )  GOTO  270  MEL09240 

DO  261  IY=1,25  MEL09250 

!61  PHI(IY,1)=1.E-10  MEL09260 

PHI(26,1)=0.05  MEL09270 

PHI(27,1)=0.045  MEL09280 

PHI(28,1)=0.04  MEL09290 

PHI(29,1)=0.035  MEL09300 

PHI(30,1)=0.03  MEL09310 

PHI(31,1)=0.025  MEL09320 

PHI(32,1)=0.02  MEL09330 

PHI(33,1)=0.015  MEL09340 

PHI(34,1)=0.01  MEL09350 

PHI(35,1)=1.E-10  MEL09360 
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FILE:  MEL3SAT   FORTRAN   Al 


262 


27  0 
2000 


DO  262  IY=36,100 
PHI(IY,1)=1.E-10 
WRITE(FTAPE)(PHI(IY,1),IY= 

WRITEC6,*)  • 

CONTINUE 
CONTINUE 
RETURN 
END 


1/100) 

~  WRITTEN 


,MPHI 


MEL09370 
MEL09380 
MEL09390 
MEL09400 
MEL09410 
MEL09420 
MEL09430 
MEL09440 
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